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 GetHybridVentilationInputs
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN March 2007
! MODIFIED L. GU, 6/23/08, Added more controls, including simple airflow objects
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for Hybrid Ventilation Control System Availability Managers and stores it in
! appropriate data structures.
! METHODOLOGY EMPLOYED:
! Uses InputProcessor "Get" routines to obtain data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, FindIteminList, SameString, MakeUPPERCase
USE NodeInputManager, ONLY: GetOnlySingleNode, MarkNode
USE DataHeatBalance, ONLY: Zone, TotVentilation, Ventilation
USE DataLoopNode
USE General, ONLY: TrimSigDigits
USE DataAirflowNetwork, ONLY: SimulateAirflowNetwork,AirflowNetworkControlSimple,AirflowNetworkControlSimpleADS
USE DataIPShortCuts
USE CurveManager, ONLY: GetCurveIndex, GetCurveMinMaxValues, CurveValue, GetCurveType
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetHybridVentilationInputs: ' ! include trailing blank
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.FALSE. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: SysAvailNum ! DO loop index for all System Availability Managers
REAL(r64) :: SchedMin ! Minimum value specified in a schedule
REAL(r64) :: SchedMax ! Maximum value specified in a schedule
REAL(r64) :: CurveMin ! Minimum value specified in a curve
REAL(r64) :: CurveMax ! Maximum value specified in a curve
REAL(r64) :: CurveVal ! Curve value
! Get the number of occurences of each type of System Availability Manager
cCurrentModuleObject ='AvailabilityManager:HybridVentilation'
NumHybridVentSysAvailMgrs = GetNumObjectsFound(cCurrentModuleObject)
IF (NumHybridVentSysAvailMgrs == 0) RETURN
! Allocate the data arrays
ALLOCATE(HybridVentSysAvailMgrData(NumHybridVentSysAvailMgrs))
ALLOCATE(HybridVentSysAvailAirLoopNum(NumHybridVentSysAvailMgrs))
ALLOCATE(HybridVentSysAvailActualZoneNum(NumHybridVentSysAvailMgrs))
ALLOCATE(HybridVentSysAvailVentCtrl(NumHybridVentSysAvailMgrs))
ALLOCATE(HybridVentSysAvailANCtrlStatus(NumHybridVentSysAvailMgrs))
ALLOCATE(HybridVentSysAvailMaster(NumHybridVentSysAvailMgrs))
ALLOCATE(HybridVentSysAvailWindModifier(NumHybridVentSysAvailMgrs))
HybridVentSysAvailANCtrlStatus = 0
HybridVentSysAvailMaster = 0
DO SysAvailNum = 1,NumHybridVentSysAvailMgrs
CALL GetObjectItem(cCurrentModuleObject,SysAvailNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),HyBridVentSysAvailMgrData%AirLoopName,SysAvailNum-1,IsNotOK,IsBlank,&
TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
HybridVentSysAvailMgrData(SysAvailNum)%Name = cAlphaArgs(1)
HybridVentSysAvailMgrData(SysAvailNum)%MgrType = SysAvailMgr_HybridVent
HybridVentSysAvailMgrData(SysAvailNum)%AirLoopName = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN ! Hybrid ventilation manager applied to zone
HybridVentSysAvailMgrData(SysAvailNum)%HybridVentMgrConnectedToAirLoop = .FALSE.
ENDIF
HybridVentSysAvailMgrData(SysAvailNum)%ControlZoneName = cAlphaArgs(3)
! Check zone number
HybridVentSysAvailMgrData(SysAvailNum)%ActualZoneNum = FindItemInList(cAlphaArgs(3),Zone%Name,NumOfZones)
IF (HybridVentSysAvailMgrData(SysAvailNum)%ActualZoneNum .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'" invalid')
CALL ShowContinueError('not found: '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
ErrorsFound = .TRUE.
END IF
HybridVentSysAvailMgrData(SysAvailNum)%ControlModeSchedPtr = GetScheduleIndex(cAlphaArgs(4))
IF (HybridVentSysAvailMgrData(SysAvailNum)%ControlModeSchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'" invalid')
CALL ShowContinueError('not found: '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'".')
ErrorsFound = .TRUE.
END IF
! Check schedule values
SchedMin=GetScheduleMinValue(HybridVentSysAvailMgrData(SysAvailNum)%ControlModeSchedPtr)
SchedMax=GetScheduleMaxValue(HybridVentSysAvailMgrData(SysAvailNum)%ControlModeSchedPtr)
IF (SchedMin == 0 .and. SchedMax == 0) THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))// &
'" specifies control mode 0 for all entries.')
CALL ShowContinueError('All zones using this '//TRIM(cAlphaFieldNames(4))//' have no hybrid ventilation control.')
END IF
IF (SchedMax > 4.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))// &
'", the maximum schedule value should be 4. However, ')
CALL ShowContinueError('the maximum entered value in the schedule is '//TRIM(TrimSigDigits(SchedMax,1)))
ErrorsFound = .TRUE.
END IF
IF (SchedMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))// &
'the minimum schedule value should be 0. However, ')
CALL ShowContinueError('the minimum entered value in the schedule is '//TRIM(TrimSigDigits(SchedMin,1)))
ErrorsFound = .TRUE.
END IF
! Read use weather rain indicator
IF (SameString(cAlphaArgs(5), 'YES')) THEN
HybridVentSysAvailMgrData(SysAvailNum)%UseRainIndicator = .TRUE.
ELSEIF (SameString(cAlphaArgs(5), 'NO')) THEN
HybridVentSysAvailMgrData(SysAvailNum)%UseRainIndicator = .FALSE.
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('..invalid value: '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))//'".')
CALL ShowContinueError('Valid choices are Yes or No.')
ErrorsFound = .TRUE.
END IF
! Check max wind speed
IF (NumNumbers > 0) THEN
HybridVentSysAvailMgrData(SysAvailNum)%MaxWindSpeed = rNumericArgs(1)
IF (rNumericArgs(1) > 40.0d0 .OR. rNumericArgs(1) < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' is beyond the range.')
CALL ShowContinueError('The input value is '//TRIM(TrimSigDigits(rNumericArgs(1),0))// &
'. The allowed value must be >= 0 and <= 40 m/s')
ErrorsFound = .TRUE.
END IF
END IF
! Read Max and Min outdoor temperature
IF (NumNumbers > 1) THEN
HybridVentSysAvailMgrData(SysAvailNum)%MinOutdoorTemp = rNumericArgs(2)
IF (rNumericArgs(2) > 100.0d0 .OR. rNumericArgs(2) < -100.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' is beyond the range.')
CALL ShowContinueError('The input value is '//TRIM(TrimSigDigits(rNumericArgs(2),0))// &
'. The allowed value must be between -100 C and +100 C')
ErrorsFound = .TRUE.
END IF
END IF
IF (NumNumbers > 2) THEN
HybridVentSysAvailMgrData(SysAvailNum)%MaxOutdoorTemp = rNumericArgs(3)
IF (rNumericArgs(3) > 100.0d0 .OR. rNumericArgs(3) < -100.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' is beyond the range.')
CALL ShowContinueError('The input value is '//TRIM(TrimSigDigits(rNumericArgs(3),0))// &
'. The allowed value must be between -100 C and +100 C')
ErrorsFound = .TRUE.
END IF
END IF
! Ensure MaxTemp >= MinTemp
IF (rNumericArgs(2) >= rNumericArgs(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" The '//TRIM(cNumericFieldNames(2))//' must be less than the '// &
TRIM(cNumericFieldNames(3)))
CALL ShowContinueError('The '//TRIM(cNumericFieldNames(2))//' is '//TRIM(TrimSigDigits(rNumericArgs(2),0))// &
'. The '//TRIM(cNumericFieldNames(3))//' is '//TRIM(TrimSigDigits(rNumericArgs(3),0))//'.')
ErrorsFound = .TRUE.
END IF
! Read Max and Min outdoor enthalpy
IF (NumNumbers > 3) THEN
HybridVentSysAvailMgrData(SysAvailNum)%MinOutdoorEnth = rNumericArgs(4)
IF (rNumericArgs(4) > 300000.0d0 .OR. rNumericArgs(4) < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//' is beyond the range.')
CALL ShowContinueError('The input value is '//TRIM(TrimSigDigits(rNumericArgs(4),0))// &
'. The allowed value must be between 0 and 300000 J/kg')
ErrorsFound = .TRUE.
END IF
END IF
IF (NumNumbers > 4) THEN
HybridVentSysAvailMgrData(SysAvailNum)%MaxOutdoorEnth = rNumericArgs(5)
IF (rNumericArgs(5) > 300000.0d0 .OR. rNumericArgs(5) < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' is beyond the range.')
CALL ShowContinueError('The input value is '//TRIM(TrimSigDigits(rNumericArgs(5),0))// &
'. The allowed value must be between 0 and 300000 J/kg')
ErrorsFound = .TRUE.
END IF
END IF
! Ensure MaxEnth >= MiniEnth
IF (rNumericArgs(4) >= rNumericArgs(5)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" The '//TRIM(cNumericFieldNames(4))//' must be less than the '// &
TRIM(cNumericFieldNames(5)))
CALL ShowContinueError('The '//TRIM(cNumericFieldNames(4))//' is '//TRIM(TrimSigDigits(rNumericArgs(4),0))// &
'. The '//TRIM(cNumericFieldNames(5))//' is '//TRIM(TrimSigDigits(rNumericArgs(5),0))//'.')
ErrorsFound = .TRUE.
END IF
! Read Max and Min outdoor dew point
IF (NumNumbers > 5) THEN
HybridVentSysAvailMgrData(SysAvailNum)%MinOutdoorDewPoint = rNumericArgs(6)
IF (rNumericArgs(6) > 100.0d0 .OR. rNumericArgs(6) < -100.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' is beyond the range.')
CALL ShowContinueError('The input value is '//TRIM(TrimSigDigits(rNumericArgs(6),0))// &
'. The allowed value must be between -100 C and +100 C')
ErrorsFound = .TRUE.
END IF
END IF
IF (NumNumbers > 6) THEN
HybridVentSysAvailMgrData(SysAvailNum)%MaxOutdoorDewPoint = rNumericArgs(7)
IF (rNumericArgs(7) > 100.0d0 .OR. rNumericArgs(7) < -100.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(7))//' is beyond the range.')
CALL ShowContinueError('The input value is '//TRIM(TrimSigDigits(rNumericArgs(7),0))// &
'. The allowed value must be between -100 C and +100 C')
ErrorsFound = .TRUE.
END IF
END IF
! Ensure MaxTemp >= MinTemp
IF (rNumericArgs(6) >= rNumericArgs(7)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" The '//TRIM(cNumericFieldNames(6))//' must be less than the '// &
TRIM(cNumericFieldNames(7)))
CALL ShowContinueError('The '//TRIM(cNumericFieldNames(6))//' is '//TRIM(TrimSigDigits(rNumericArgs(6),0))// &
'. The '//TRIM(cNumericFieldNames(7))//' is '//TRIM(TrimSigDigits(rNumericArgs(7),0))//'.')
ErrorsFound = .TRUE.
END IF
HybridVentSysAvailMgrData(SysAvailNum)%MinOASched = cAlphaArgs(6)
HybridVentSysAvailMgrData(SysAvailNum)%MinOASchedPtr = GetScheduleIndex(cAlphaArgs(6))
IF (HybridVentSysAvailMgrData(SysAvailNum)%MinOASchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid')
CALL ShowContinueError('..not found: '//TRIM(cAlphaFieldNames(6))//'="'//TRIM(cAlphaArgs(6))//'".')
ErrorsFound = .TRUE.
END IF
SchedMin=GetScheduleMinValue(HybridVentSysAvailMgrData(SysAvailNum)%MinOASchedPtr)
IF (SchedMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="' //TRIM(cAlphaArgs(1))// &
'", Schedule value must be >= 0 in '// &
TRIM(cAlphaFieldNames(6))//'="'//TRIM(cAlphaArgs(6))//'".')
CALL ShowContinueError('The minimum schedule value is '//TRIM(TrimSigDigits(SchedMin,1)))
ErrorsFound = .TRUE.
END IF
IF (.NOT. lAlphaFieldBlanks(7)) THEN
HybridVentSysAvailMgrData(SysAvailNum)%OpeningFactorFWS = GetCurveIndex(cAlphaArgs(7))
IF (HybridVentSysAvailMgrData(SysAvailNum)%OpeningFactorFWS .LE. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(' not found: '//TRIM(cAlphaFieldNames(7))//'="'//TRIM(cAlphaArgs(7))//'".')
ErrorsFound = .TRUE.
ELSE
CALL GetCurveMinMaxValues(HybridVentSysAvailMgrData(SysAvailNum)%OpeningFactorFWS,CurveMin,CurveMax)
IF (CurveMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('The minimum wind speed used in '//TRIM(cAlphaFieldNames(7))//'="'//TRIM(cAlphaArgs(7))// &
'should be greater than or equal to 0.0 (m/s)')
CALL ShowContinueError('Curve minimum value appears to be less than 0.')
ErrorsFound = .TRUE.
END IF
CurveVal = CurveValue(HybridVentSysAvailMgrData(SysAvailNum)%OpeningFactorFWS,CurveMin)
IF(CurveVal .LT. 0.0d0)THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('The minimum value of '//TRIM(cAlphaFieldNames(7))//' must be greater ' &
//'than or equal to 0.0 at the minimum value of wind speed.')
CALL ShowContinueError(TRIM(cAlphaFieldNames(7))//'="'//TRIM(cAlphaArgs(7))//'".')
CALL ShowContinueError('Curve output at the minimum wind speed = '//TRIM(TrimSigDigits(CurveVal,3)))
ErrorsFound = .TRUE.
END IF
CurveVal = CurveValue(HybridVentSysAvailMgrData(SysAvailNum)%OpeningFactorFWS,CurveMax)
IF(CurveVal .GT. 1.0d0)THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('The maximum value of '//TRIM(cAlphaFieldNames(7))//' must be less ' &
//'than or equal to 1.0 at the maximum value of wind speed.')
CALL ShowContinueError(TRIM(cAlphaFieldNames(7))//'="'//TRIM(cAlphaArgs(7))//'".')
CALL ShowContinueError('Curve output at the maximum wind speed = '//TRIM(TrimSigDigits(CurveVal,3)))
ErrorsFound = .TRUE.
END IF
! Check curve type
SELECT CASE(GetCurveType(HybridVentSysAvailMgrData(SysAvailNum)%OpeningFactorFWS))
CASE('QUADRATIC')
CASE('LINEAR')
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Illegal curve type for '//TRIM(cAlphaFieldNames(7))//'="'//TRIM(cAlphaArgs(7))//'".')
ErrorsFound = .TRUE.
END SELECT
END IF
END IF
HybridVentSysAvailMgrData(SysAvailNum)%ANControlTypeSchedPtr = GetScheduleIndex(cAlphaArgs(8))
IF (HybridVentSysAvailMgrData(SysAvailNum)%ANControlTypeSchedPtr > 0) THEN
HybridVentSysAvailMaster(SysAvailNum) = HybridVentSysAvailMgrData(SysAvailNum)%ActualZoneNum
! Check schedule values
SchedMin=GetScheduleMinValue(HybridVentSysAvailMgrData(SysAvailNum)%ANControlTypeSchedPtr)
SchedMax=GetScheduleMaxValue(HybridVentSysAvailMgrData(SysAvailNum)%ANControlTypeSchedPtr)
HybridVentSysAvailANCtrlStatus(SysAvailNum) = HybridVentSysAvailMgrData(SysAvailNum)%ANControlTypeSchedPtr
IF (SchedMax > 1.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(' For '//TRIM(cAlphaFieldNames(8))//'="'//TRIM(cAlphaArgs(8))//'",')
CALL ShowContinueError('the maximum schedule value should be 1. However, ')
CALL ShowContinueError('the maximum entered value in the schedule is '//TRIM(TrimSigDigits(SchedMax,1)))
ErrorsFound = .TRUE.
END IF
IF (SchedMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('For '//TRIM(cAlphaFieldNames(8))//'="'//TRIM(cAlphaArgs(8))//'",')
CALL ShowContinueError('the minimum schedule value should be 0. However, ')
CALL ShowContinueError('the minimum entered value in the schedule is '//TRIM(TrimSigDigits(SchedMin,1)))
ErrorsFound = .TRUE.
END IF
END IF
HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr = GetScheduleIndex(cAlphaArgs(9))
IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr > 0 .AND. &
HybridVentSysAvailMgrData(SysAvailNum)%ANControlTypeSchedPtr > 0) THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('The inputs for'//TRIM(cAlphaFieldNames(8))// &
' and '//TRIM(cAlphaFieldNames(9))//' are valid.')
CALL ShowContinueError('But both objects cannot work at the same time. The Simple Airflow Control is disabled')
HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr = 0
ELSE IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr > 0) THEN
! Check schedule values
SchedMin=GetScheduleMinValue(HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr)
SchedMax=GetScheduleMaxValue(HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr)
IF (SchedMax > 1.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('For '//TRIM(cAlphaFieldNames(9))//'="'//TRIM(cAlphaArgs(9))//'",')
CALL ShowContinueError('the maximum schedule value should be 1. However, ')
CALL ShowContinueError('the maximum entered value in the schedule is '//TRIM(TrimSigDigits(SchedMax,1)))
ErrorsFound = .TRUE.
END IF
IF (SchedMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('For '//TRIM(cAlphaFieldNames(9))//'="'//TRIM(cAlphaArgs(9))//'",')
CALL ShowContinueError('the minimum schedule value should be 0. However, ')
CALL ShowContinueError('the minimum entered value in the schedule is '//TRIM(TrimSigDigits(SchedMin,1)))
ErrorsFound = .TRUE.
END IF
END IF
IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr > 0) THEN
HybridVentSysAvailMgrData(SysAvailNum)%VentilationName = cAlphaArgs(10)
If (TotVentilation .GT. 0) Then
HybridVentSysAvailMgrData(SysAvailNum)%VentilationPtr = FindItemInList(cAlphaArgs(10),Ventilation%Name,TotVentilation)
HybridVentSysAvailMaster(SysAvailNum) = HybridVentSysAvailMgrData(SysAvailNum)%VentilationPtr
SchedMax=GetScheduleMaxValue(HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr)
IF (HybridVentSysAvailMgrData(SysAvailNum)%VentilationPtr .LE. 0 .AND. INT(SchedMax) == 1) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(10))//'="'//TRIM(cAlphaArgs(10))//'" is required and not found.')
ErrorsFound = .TRUE.
End If ! Otherwise check later
END IF
END IF
! Check simple airflow object
IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr > 0 .AND. &
HybridVentSysAvailMgrData(SysAvailNum)%VentilationPtr > 0) THEN
IF (HybridVentSysAvailMgrData(SysAvailNum)%ActualZoneNum .NE. &
Ventilation(HybridVentSysAvailMgrData(SysAvailNum)%VentilationPtr)%ZonePtr) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('The Zone name specified in the Ventilation ' &
//'object '//TRIM(Zone(Ventilation(HybridVentSysAvailMgrData(SysAvailNum)%VentilationPtr)%ZonePtr)%Name))
CALL ShowContinueError('is not equal to the '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
ErrorsFound = .TRUE.
END IF
END IF
IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr > 0 .AND. &
SimulateAirflowNetwork > AirflowNetworkControlSimple) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(HybridVentSysAvailMgrData(SysAvailNum)%Name)//'"')
CALL ShowContinueError('The simple airflow objects are used for natural ventilation calculation.')
CALL ShowContinueError('The Airflow Network model is not allowed to perform. Please set the control type = ' &
//'NoMultizoneOrDistribution')
ErrorsFound = .TRUE.
END IF
IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr == 0) THEN
IF (SimulateAirflowNetwork <= AirflowNetworkControlSimple) THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(HybridVentSysAvailMgrData(SysAvailNum)%Name)//'"')
CALL ShowContinueError ('The Airflow Network model is not available for Hybrid Ventilation Control.')
ELSE IF (SimulateAirflowNetwork == AirflowNetworkControlSimpleADS) THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(HybridVentSysAvailMgrData(SysAvailNum)%Name)//'"')
CALL ShowContinueError('Please check the AirflowNetwork Control field in the AirflowNetwork:SimulationControl object.')
CALL ShowContinueError('The suggested choices are MultizoneWithDistribution or MultizoneWithoutDistribution.')
END IF
END IF
! Disallow combination of simple control and OA control mode
SchedMax=GetScheduleMaxValue(HybridVentSysAvailMgrData(SysAvailNum)%ControlModeSchedPtr)
IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr > 0 .AND. SchedMax .EQ. 4.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('The outdoor ventilation air control type defined in '// TRIM(cAlphaArgs(4))// &
' cannot work together with '//TRIM(cAlphaFieldNames(9)))
ErrorsFound = .TRUE.
END IF
END DO ! SysAvailNum
IF (NumHybridVentSysAvailMgrs > 1) THEN
DO SysAvailNum = 2,NumHybridVentSysAvailMgrs
IF (HybridVentSysAvailMgrData(SysAvailNum-1)%ANControlTypeSchedPtr > 0) THEN
IF (HybridVentSysAvailMgrData(SysAvailNum)%SimpleControlTypeSchedPtr > 0) THEN
CALL ShowSevereError('The AirflowNetwork model is used for natural ventilation calculation in ' &
//TRIM(cCurrentModuleObject)//'="' //TRIM(HybridVentSysAvailMgrData(SysAvailNum-1)%Name)//'"')
CALL ShowContinueError('The simple airflow objects are used for natural ventilation calculation in ' &
//TRIM(cCurrentModuleObject)//'="' //TRIM(HybridVentSysAvailMgrData(SysAvailNum)%Name)//'"')
CALL ShowContinueError('The hybrid ventilation control requires the same models to calculate natural ventilation')
ErrorsFound = .TRUE.
END IF
END IF
IF (HybridVentSysAvailMgrData(SysAvailNum-1)%SimpleControlTypeSchedPtr > 0) THEN
IF (HybridVentSysAvailMgrData(SysAvailNum)%ANControlTypeSchedPtr > 0) THEN
CALL ShowSevereError('The Airflow Network model is used for natural ventilation calculation in ' &
//TRIM(cCurrentModuleObject)//'="' //TRIM(HybridVentSysAvailMgrData(SysAvailNum)%Name)//'"')
CALL ShowContinueError('The simple airflow objects are used for natural ventilation calculation in ' &
//TRIM(cCurrentModuleObject)//'="' //TRIM(HybridVentSysAvailMgrData(SysAvailNum-1)%Name)//'"')
CALL ShowContinueError('The hybrid ventilation control requires the same models to calculate natural ventilation')
ErrorsFound = .TRUE.
END IF
END IF
END DO ! SysAvailNum
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Preceding condition(s) cause termination.')
END IF
! Set up output variables
DO SysAvailNum = 1,NumHybridVentSysAvailMgrs
IF (HybridVentSysAvailMgrData(SysAvailNum)%HybridVentMgrConnectedToAirLoop) THEN
CALL SetupOutputVariable('Availability Manager Hybrid Ventilation Control Status []', &
HybridVentSysAvailMgrData(SysAvailNum)%VentilationCtrl, &
'System','Average',HybridVentSysAvailMgrData(SysAvailNum)%AirLoopName)
CALL SetupOutputVariable('Availability Manager Hybrid Ventilation Control Mode []', &
HybridVentSysAvailMgrData(SysAvailNum)%ControlMode, &
'System','Average',HybridVentSysAvailMgrData(SysAvailNum)%AirLoopName)
ELSE
CALL SetupOutputVariable('Availability Manager Hybrid Ventilation Control Status []', &
HybridVentSysAvailMgrData(SysAvailNum)%VentilationCtrl, &
'System','Average',HybridVentSysAvailMgrData(SysAvailNum)%ControlZoneName)
CALL SetupOutputVariable('Availability Manager Hybrid Ventilation Control Mode []', &
HybridVentSysAvailMgrData(SysAvailNum)%ControlMode, &
'System','Average',HybridVentSysAvailMgrData(SysAvailNum)%ControlZoneName)
ENDIF
END DO
RETURN
END SUBROUTINE GetHybridVentilationInputs