SUBROUTINE GetOAControllerInputs
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN Oct 1998
! MODIFIED Shirey/Raustad FSEC, June 2003, Jan 2004
! Mangesh Basarkar, 06/2011: Getting zone OA specifications from Design Specification Object
! Tianzhen Hong, 3/2012: getting zone air distribution effectiveness and secondary recirculation
! from DesignSpecification:ZoneAirDistribution objects
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE
! Input the OAController data and store it in the OAController array.
! Input the Ventilation:Mechanical data and store it in the VentilationMechanical array.
! Condense Ventilation:Mechanical data array to include only unique zones specified for each instance of this object.
! METHODOLOGY EMPLOYED:
! Use the Get routines from the InputProcessor module.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor
USE DataDefineEquip
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE NodeInputManager, ONLY: GetOnlySingleNode
USE DataZoneEquipment, ONLY: ZoneEquipConfig, ZoneEquipList, NumofZoneEquipLists
USE DataHeatBalance, ONLY: Zone, ZoneList, NumOfZoneLists
USE CurveManager, ONLY: GetCurveIndex, GetCurveType
USE OutputReportPredefined
USE DataAirSystems, ONLY: PrimaryAirSystem
USE DataZoneControls, ONLY: HumidityControlZone, NumHumidityControlZones
USE DataContaminantBalance, ONLY: Contaminant
USE OutAirNodeManager, ONLY: CheckOutAirNodeNumber
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=1), PARAMETER :: Blank=' '
CHARACTER(len=*), PARAMETER :: RoutineName='GetOAControllerInputs: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: MaxNumAirLoopZones ! maximum number of heating plus cooling zones attached to any air loop
INTEGER :: NumAirLoopZones ! number of heating plus cooling zones attached to a given air loop
INTEGER :: NumofAirLoop ! counter for NumPrimaryAirSys
INTEGER :: NumAirLoopCooledZones ! number of cooling zones for a given air loop
INTEGER :: NumAirLoopCooledZonesTemp ! index for number of cooling zones
INTEGER :: AirLoopZones ! total number of unique heating and cooling zones for each air loop
INTEGER :: NumAirLoopHeatedZones ! number of heating zones for a given air loop
INTEGER :: NumAirLoopHeatedZonesTemp ! index for number of heating zones
INTEGER :: ZoneNum ! zone number attached to a given air loop
LOGICAL :: CommonZone ! logical for the same zone being a cooling zone and a heating zone
INTEGER :: NumNums ! Number of real numbers returned by GetObjectItem
INTEGER :: NumAlphas ! Number of alphanumerics returned by GetObjectItem
INTEGER :: OutAirNum ! Number of Controller:OutdoorAir or CONTROLLER:STAND ALONE ERV objects
INTEGER :: OAControllerNum ! Index to Controller:OutdoorAir or CONTROLLER:STAND ALONE ERV objects
INTEGER :: VentMechNum ! Number of VENTILATION:MECHANICAL objects
INTEGER :: groupNum ! Index to group in extensible VENTILATION:MECHANICAL object
INTEGER :: IOSTAT ! Status of GetObjectItem call
REAL(r64), ALLOCATABLE, DIMENSION(:) :: NumArray
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: AlphArray
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! Object type for getting and messages
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
LOGICAL :: ErrorsFound=.false. ! Flag identifying errors found during get input
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: ZoneListNum ! Index to Zone List
INTEGER :: ScanZoneListNum ! Index used to loop through zone list
INTEGER :: MechVentZoneCount ! Index counter for zones with mechanical ventilation
!LOGICAL :: FoundUniqueZone ! Flag to verify VENTIALTION:MECHANICAL zones are unique and no duplicates exist
!INTEGER :: NumVentMechZone ! Index counter for checking mechanical ventilation zone uniqeness
LOGICAL :: ErrorInName ! Error returned from VerifyName call
INTEGER :: NumArg ! Number of arguments from GetObjectDefMaxArgs call
INTEGER :: MaxAlphas ! Maximum alphas in multiple objects
INTEGER :: MaxNums ! Maximum numbers in multiple objects
!INTEGER :: ERVControllerNum ! Index to Controller:Stand Alone ERV
Integer :: ControlledZoneNum ! Index to controlled zones
LOGICAL :: AirNodeFound ! Used to determine if control zone is valid
LOGICAL :: AirLoopFound ! Used to determine if control zone is served by furnace air loop
INTEGER :: AirLoopNumber ! Used to determine if control zone is served by furnace air loop
INTEGER :: BranchNum ! Used to determine if control zone is served by furnace air loop
INTEGER :: CompNum ! Used to determine if control zone is served by furnace air loop
INTEGER :: HstatZoneNum ! Used to determine if control zone has a humidistat object
INTEGER :: OASysNum ! Used to find OA System index for OA Controller
INTEGER :: OASysIndex ! Index to OA System
LOGICAL :: OASysFound ! OA Controller found OA System index
REAL(r64) :: OAFlowRatio ! Ratio of minimum OA flow rate to maximum OA flow rate
INTEGER :: NumGroups ! Number of extensible input groups of the VentilationMechanical object
INTEGER :: numBaseNum ! base number for numeric arguments (for readability)
!INTEGER :: OAIndex ! Loop index for design specification outdoor air object list
!INTEGER :: NumControllerList = 0 ! Index to controller lists
INTEGER :: ControllerListNum = 0 ! Index used to loop through controller list
INTEGER :: ControllerNum = 0 ! Index to controllers in each controller list
INTEGER :: Num = 0 ! Index used to loop through controllers in list
INTEGER :: SysNum = 0 ! Index used to loop through OA systems
REAL(r64) :: DesSupplyVolFlowRate = 0.0d0 ! Temporary variable for design supply volumetric flow rate for air loop (m3/s)
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE:: DesignSpecOAObjName ! name of the design specification outdoor air object
INTEGER,DIMENSION(:),ALLOCATABLE:: DesignSpecOAObjIndex ! index of the design specification outdoor air object
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE:: VentMechZoneName ! Zone or Zone List to apply mechanical ventilation rate
REAL(r64), DIMENSION(:),ALLOCATABLE:: VentMechZoneOAAreaRate ! Mechanical ventilation rate (m3/s/m2) for zone or zone list
REAL(r64), DIMENSION(:),ALLOCATABLE:: VentMechZoneOAPeopleRate ! Mechanical ventilation rate (m3/s/person) for zone or zone list
REAL(r64), DIMENSION(:),ALLOCATABLE:: VentMechZoneOAFlow ! Mechanical ventilation rate (m3/s/person) for zone or zone list
REAL(r64), DIMENSION(:),ALLOCATABLE:: VentMechZoneOAACH ! Mechanical ventilation rate (m3/s/person) for zone or zone list
REAL(r64), DIMENSION(:),ALLOCATABLE:: VentMechZoneADEffCooling ! Zone air distribution effectiveness in cooling mode
! for each zone or zone list
REAL(r64), DIMENSION(:),ALLOCATABLE:: VentMechZoneADEffHeating ! Zone air distribution effectiveness in heating mode
! for each zone or zone list
INTEGER, DIMENSION(:),ALLOCATABLE:: VentMechZoneADEffSchPtr ! Pointer to the zone air distribution effectiveness schedule
! for each zone or zone list
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE:: VentMechZoneADEffSchName ! Zone air distribution effectiveness
! schedule name for each zone or zone list
REAL(r64), DIMENSION(:),ALLOCATABLE:: VentMechZoneSecondaryRecirculation ! Zone air secondary recirculation ratio
! for each zone or zone list
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE:: DesignSpecZoneADObjName ! name of the design specification zone air
! distribution object for each zone or zone list
INTEGER,DIMENSION(:),ALLOCATABLE:: DesignSpecZoneADObjIndex ! index of the design specification zone air distribution object
INTEGER :: ObjIndex = 0
INTEGER :: EquipListIndex = 0
INTEGER :: EquipNum = 0
INTEGER :: EquipListNum = 0
INTEGER :: ADUNum = 0
INTEGER :: jZone
INTEGER :: i
!First, call other get input routines in this module to make sure data is filled during this routine.
IF (GetOASysInputFlag) THEN ! Gets input for object first time Sim routine is called
CALL GetOutsideAirSysInputs
GetOASysInputFlag=.false.
END IF
IF (GetOAMixerInputFlag) THEN ! Gets input for object first time Sim routine is called
CALL GetOAMixerInputs
GetOAMixerInputFlag=.false.
END IF
CALL GetObjectDefMaxArgs(CurrentModuleObjects(CMO_OAController),NumArg,NumAlphas,NumNums)
MaxAlphas=NumAlphas
MaxNums=NumNums
CALL GetObjectDefMaxArgs(CurrentModuleObjects(CMO_ERVController),NumArg,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
CALL GetObjectDefMaxArgs(CurrentModuleObjects(CMO_MechVentilation),NumArg,NumAlphas,NumNums)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
MaxNums=MAX(MaxNums,NumNums)
ALLOCATE(AlphArray(MaxAlphas))
AlphArray=' '
ALLOCATE(NumArray(MaxNums))
NumArray=0.0d0
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.true.
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields = ' '
ALLOCATE(cNumericFields(MaxNums))
cNumericFields = ' '
NumOAControllers = GetNumObjectsFound(CurrentModuleObjects(CMO_OAController))
NumERVControllers = GetNumObjectsFound(CurrentModuleObjects(CMO_ERVController))
NumOAControllers = NumOAControllers + NumERVControllers
! Mangesh code to fix CR 8225 - 09/14/2010
!NumControllerList = GetNumObjectsFound("AirLoopHVAC:ControllerList")
!NumOASys = GetNumObjectsFound("AirLoopHVAC:OutdoorAirSystem")
IF (NumOAControllers.GT.0) THEN
ALLOCATE(OAController(NumOAControllers))
ALLOCATE(OAControllerInfo(NumOAControllers))
CurrentModuleObject = CurrentModuleObjects(CMO_OAController)
DO OutAirNum=1,NumOAControllers-NumERVControllers
CALL GetObjectItem(CurrentModuleObject,OutAirNum,AlphArray,NumAlphas,&
NumArray,NumNums,IOSTAT,NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),OAController%Name,OutAirNum-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
OAController(OutAirNum)%Name = AlphArray(1)
OAController(OutAirNum)%ControllerType = TRIM(CurrentModuleObject)
OAController(OutAirNum)%ControllerType_Num = ControllerOutsideAir
OAController(OutAirNum)%MaxOA = NumArray(2)
OAController(OutAirNum)%MinOA = NumArray(1)
OAController(OutAirNum)%MixNode = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Sensor,1,ObjectIsNotParent)
OAController(OutAirNum)%OANode = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Actuator,1,ObjectIsNotParent)
IF (.not. CheckOutAirNodeNumber(OAController(OutAirNum)%OANode)) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid field ')
CALL ShowContinueError(TRIM(cAlphaFields(5))//'="'//trim(AlphArray(5))//'",'// &
' must be an OutdoorAir:Node for outdoor air to be effective.')
ErrorsFound=.true.
ENDIF
IF (Samestring(AlphArray(6),'NoEconomizer')) THEN
OAController(OutAirNum)%Econo = NoEconomizer
ELSE IF (Samestring(AlphArray(6),'FixedDryBulb')) THEN
OAController(OutAirNum)%Econo = FixedDryBulb
ELSE IF (Samestring(AlphArray(6),'FixedEnthalpy')) THEN
OAController(OutAirNum)%Econo = FixedEnthalpy
ELSE IF (Samestring(AlphArray(6),'FixedDewPointAndDryBulb')) THEN
OAController(OutAirNum)%Econo = FixedDewpointAndDryBulb
ELSE IF (Samestring(AlphArray(6),'DifferentialDryBulb')) THEN
OAController(OutAirNum)%Econo = DifferentialDryBulb
ELSE IF (Samestring(AlphArray(6),'DifferentialEnthalpy')) THEN
OAController(OutAirNum)%Econo = DifferentialEnthalpy
ELSE IF (Samestring(AlphArray(6),'DifferentialDryBulbAndEnthalpy')) THEN
OAController(OutAirNum)%Econo = DifferentialDryBulbAndEnthalpy
ELSE IF (Samestring(AlphArray(6),'ElectronicEnthalpy')) THEN
OAController(OutAirNum)%Econo = ElectronicEnthalpy
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(6))//'="'//trim(AlphArray(6))//'" value.')
ErrorsFound=.true.
END IF
!Bypass choice - Added by Amit for new feature implementation
IF(Samestring(AlphArray(7),'ModulateFlow')) THEN
OAController(OutAirNum)%Econbypass = .FALSE.
ELSE IF(Samestring(AlphArray(7),'MinimumFlowWithBypass')) THEN
OAController(OutAirNum)%EconBypass = .TRUE.
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(7))//'="'//trim(AlphArray(7))//'" value.')
ErrorsFound=.true.
END IF
! IF((OAController(OutAirNum)%Econo > NoEconomizer) .AND. OAController(OutAirNum)%EconBypass) THEN
! CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
! TRIM(cAlphaFields(6))//'="'//trim(AlphArray(6))//'" and ')
! CALL ShowContinueError(TRIM(cAlphaFields(7))//'="'//trim(AlphArray(7))//'" incompatible specifications.')
! Errorsfound = .TRUE.
! END IF
IF (SameString(AlphArray(9),'NoLockout')) THEN
OAController(OutAirNum)%Lockout = NoLockoutPossible
ELSE IF (SameString(AlphArray(9),'LockoutWithHeating')) THEN
OAController(OutAirNum)%Lockout = LockoutWithHeatingPossible
ELSE IF (SameString(AlphArray(9),'LockoutWithCompressor')) THEN
OAController(OutAirNum)%Lockout = LockoutWithCompressorPossible
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(9))//'="'//trim(AlphArray(9))//'" value.')
ErrorsFound=.true.
END IF
IF (SameString(AlphArray(10),'FixedMinimum')) THEN
OAController(OutAirNum)%FixedMin = .TRUE.
ELSE
OAController(OutAirNum)%FixedMin = .FALSE.
END IF
IF (lNumericBlanks(3)) THEN
OAController(OutAirNum)%TempLim = BlankNumeric
ELSE
OAController(OutAirNum)%TempLim = NumArray(3)
END IF
IF (lNumericBlanks(4)) THEN
OAController(OutAirNum)%EnthLim = BlankNumeric
ELSE
OAController(OutAirNum)%EnthLim = NumArray(4)
END IF
IF (lNumericBlanks(5)) THEN
OAController(OutAirNum)%DPTempLim = BlankNumeric
ELSE
OAController(OutAirNum)%DPTempLim = NumArray(5)
END IF
IF (lNumericBlanks(6)) THEN
OAController(OutAirNum)%TempLowLim = BlankNumeric
ELSE
OAController(OutAirNum)%TempLowLim = NumArray(6)
END IF
IF(.NOT. lAlphaBlanks(8))THEN
OAController(OutAirNum)%EnthalpyCurvePtr = GetCurveIndex(AlphArray(8)) ! convert curve name to number
IF (OAController(OutAirNum)%EnthalpyCurvePtr .EQ. 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(8))//'="'//trim(AlphArray(8))//'" not found.')
ErrorsFound = .TRUE.
ELSE
! Verify Curve Object, only legal types are Quadratic and Cubic
SELECT CASE(GetCurveType(OAController(OutAirNum)%EnthalpyCurvePtr))
CASE('QUADRATIC')
CASE('CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(8))//'="'//trim(AlphArray(8))//'".')
CALL ShowContinueError('...must be Quadratic or Cubic curve.')
ErrorsFound=.true.
END SELECT
END IF
END IF
OAController(OutAirNum)%RelNode = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Actuator,1,ObjectIsNotParent)
OAController(OutAirNum)%RetNode = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Sensor,1,ObjectIsNotParent)
OAController(OutAirNum)%MinOASch = AlphArray(11)
OAController(OutAirNum)%MinOASchPtr = GetScheduleIndex(AlphArray(11))
IF (OAController(OutAirNum)%MinOASchPtr == 0 .AND. (.NOT. lAlphaBlanks(11))) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(11))//'="'//trim(AlphArray(11))//'" not found.')
ErrorsFound=.true.
ENDIF
! Changed by Amit for new feature implementation
OAController(OutAirNum)%MinOAflowSch = AlphArray(12)
OAController(OutAirNum)%MinOAflowSchPtr = GetScheduleIndex(AlphArray(12))
IF (OAController(OutAirNum)%MinOAflowSchPtr == 0 .AND. (.NOT. lAlphaBlanks(12))) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(12))//'="'//trim(AlphArray(12))//'" not found.')
ErrorsFound=.true.
ENDIF
OAController(OutAirNum)%MaxOAflowSch = AlphArray(13)
OAController(OutAirNum)%MaxOAflowSchPtr = GetScheduleIndex(AlphArray(13))
IF (OAController(OutAirNum)%MaxOAflowSchPtr == 0 .AND. (.NOT. lAlphaBlanks(13))) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(13))//'="'//trim(AlphArray(13))//'" not found.')
ErrorsFound=.true.
ENDIF
OAController(OutAirNum)%VentilationMechanicalName = AlphArray(14)
! Check for a time of day economizer control schedule
OAController(OutAirNum)%EconomizerOASchedPtr = GetScheduleIndex(AlphArray(15))
! High humidity control option can be used with any economizer flag
IF(SameString(AlphArray(16),'Yes'))THEN
OAController(OutAirNum)%HumidistatZoneNum = FindItemInList(AlphArray(17),Zone%Name,NumOfZones)
! Get the node number for the zone with the humidistat
IF (OAController(OutAirNum)%HumidistatZoneNum > 0) THEN
AirNodeFound=.FALSE.
AirLoopFound=.FALSE.
OASysFound =.FALSE.
DO ControlledZoneNum = 1,NumOfZones
IF (ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum /= OAController(OutAirNum)%HumidistatZoneNum) CYCLE
! Find the controlled zone number for the specified humidistat location
OAController(OutAirNum)%NodeNumofHumidistatZone=ZoneEquipConfig(ControlledZoneNum)%ZoneNode
! Determine which OA System uses this OA Controller
OASysIndex = 0
DO OASysNum = 1, NumOASystems
DO OAControllerNum = 1, OutsideAirSys(OASysNum)%NumControllers
IF(.NOT. SameString(OutsideAirSys(OASysNum)%ControllerType(OAControllerNum),CurrentModuleObject) .OR. &
.NOT. SameString(OutsideAirSys(OASysNum)%ControllerName(OAControllerNum),OAController(OutAirNum)%Name)) CYCLE
OASysIndex = OASysNum
OASysFound = .TRUE.
EXIT
END DO
IF(OASysFound) EXIT
END DO
! Determine if furnace is on air loop served by the humidistat location specified
AirLoopNumber = ZoneEquipConfig(ControlledZoneNum)%AirLoopNum
IF(AirLoopNumber .GT. 0 .AND. OASysIndex .GT. 0)THEN
DO BranchNum = 1, PrimaryAirSystem(AirLoopNumber)%NumBranches
DO CompNum = 1, PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%TotalComponents
IF(.NOT. SameString(PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%Comp(CompNum)%Name, &
OutsideAirSys(OASysIndex)%Name) .OR. &
.NOT. SameString(PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%Comp(CompNum)%TypeOf, &
'AirLoopHVAC:OutdoorAirSystem'))CYCLE
AirLoopFound=.TRUE.
EXIT
END DO
IF(AirLoopFound)EXIT
END DO
DO HstatZoneNum = 1, NumHumidityControlZones
IF(HumidityControlZone(HstatZoneNum)%ActualZoneNum .NE. OAController(OutAirNum)%HumidistatZoneNum)CYCLE
AirNodeFound=.TRUE.
EXIT
END DO
ELSE
IF(AirLoopNumber .EQ. 0)THEN
CALL ShowSevereError('Did not find a Primary Air Loop for ' &
//TRIM(OAController(OutAirNum)%ControllerType)//' = "' &
//TRIM(OAController(OutAirNum)%Name)//'"')
CALL ShowContinueError('Specified '//TRIM(cAlphaFields(17))//' = '//TRIM(AlphArray(17)))
ErrorsFound=.TRUE.
END IF
IF(OASysIndex .EQ. 0)THEN
CALL ShowSevereError('Did not find an AirLoopHVAC:OutdoorAirSystem for ' &
//TRIM(OAController(OutAirNum)%ControllerType)//' = "' &
//TRIM(OAController(OutAirNum)%Name)//'"')
ErrorsFound=.TRUE.
END IF
END IF
EXIT
ENDDO
IF (.not. AirNodeFound) THEN
CALL ShowSevereError('Did not find Air Node (Zone with Humidistat), ' &
//TRIM(OAController(OutAirNum)%ControllerType)//' = "' &
//TRIM(OAController(OutAirNum)%Name)//'"')
CALL ShowContinueError('Specified '//TRIM(cAlphaFields(17))//' = '//TRIM(AlphArray(17)))
CALL ShowContinueError('Both a ZoneHVAC:EquipmentConnections object and a ZoneControl:Humidistat object' &
//' must be specified for this zone.')
ErrorsFound=.TRUE.
ENDIF
IF (.not. AirLoopFound) THEN
CALL ShowSevereError('Did not find correct Primary Air Loop for ' &
//TRIM(OAController(OutAirNum)%ControllerType)//' = "' &
//TRIM(OAController(OutAirNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFields(17))//' = '//TRIM(AlphArray(17))// &
' is not served by this Primary Air Loop equipment.')
ErrorsFound=.TRUE.
ENDIF
ELSE
CALL ShowSevereError('Did not find Air Node (Zone with Humidistat), ' &
//TRIM(OAController(OutAirNum)%ControllerType)//' = "' &
//TRIM(OAController(OutAirNum)%Name)//'"')
CALL ShowContinueError('Specified '//TRIM(cAlphaFields(17))//' = '//TRIM(AlphArray(17)))
CALL ShowContinueError('Both a ZoneHVAC:EquipmentConnections object and a ZoneControl:Humidistat object' &
//' must be specified for this zone.')
ErrorsFound=.TRUE.
ENDIF
OAController(OutAirNum)%HighRHOAFlowRatio = NumArray(7)
IF(OAController(OutAirNum)%HighRHOAFlowRatio .LE. 0.0d0 .AND. NumNums .GT. 6)THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//' "'//TRIM(OAController(OutAirNum)%Name)//'"')
CALL ShowContinueError(' '//TRIM(cNumericFields(7))//' must be greater than 0.')
CALL ShowContinueError(' '//TRIM(cNumericFields(7))//' is reset to 1 and the simulation continues.')
OAController(OutAirNum)%HighRHOAFlowRatio = 1.0d0
END IF
IF(SameString(AlphArray(16),'Yes') .AND. OAController(OutAirNum)%FixedMin)THEN
IF(OAController(OutAirNum)%MaxOA .GT. 0.0d0 .AND. OAController(OutAirNum)%MinOA .NE. AutoSize)THEN
OAFlowRatio = OAController(OutAirNum)%MinOA/OAController(OutAirNum)%MaxOA
IF(OAController(OutAirNum)%HighRHOAFlowRatio .LT. OAFlowRatio)THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//' "'//TRIM(OAController(OutAirNum)%Name)//'"')
CALL ShowContinueError('... A fixed minimum outside air flow rate and high humidity control have been specified.')
CALL ShowContinueError('... The '//TRIM(cNumericFields(7))//' is less than the ratio of'// &
' the outside air controllers minimum to maximum outside air flow rate.')
CALL ShowContinueError('... Controller '//TRIM(cNumericFields(1))//' = ' &
//TRIM(TrimSigDigits(OAController(OutAirNum)%MinOA,4))//' m3/s.')
CALL ShowContinueError('... Controller '//TRIM(cNumericFields(2))//' = ' &
//TRIM(TrimSigDigits(OAController(OutAirNum)%MaxOA,4))//' m3/s.')
CALL ShowContinueError('... Controller minimum to maximum flow ratio = ' &
//TRIM(TrimSigDigits(OAFlowRatio,4))//'.')
CALL ShowContinueError('... '//TRIM(cNumericFields(7))//' = ' &
//TRIM(TrimSigDigits(OAController(OutAirNum)%HighRHOAFlowRatio,4))//'.')
END IF
END IF
END If
IF(SameString(AlphArray(18), 'Yes'))THEN
OAController(OutAirNum)%ModifyDuringHighOAMoisture = .FALSE.
ELSEIF (SameString(AlphArray(18), 'No'))THEN
OAController(OutAirNum)%ModifyDuringHighOAMoisture = .TRUE.
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' "'//TRIM(OAController(OutAirNum)%Name)//'", invalid field value')
CALL ShowContinueError('...'//trim(cAlphaFields(18))//'="'//trim(AlphArray(18))//'" - valid values are "Yes" or "No".')
ErrorsFound=.TRUE.
END IF
ELSEIF (SameString(AlphArray(16),'No') .or. lAlphaBlanks(16))THEN
IF (NumAlphas >= 18) THEN
IF(.not. SameString(AlphArray(18), 'Yes') .and. .not. SameString(AlphArray(18), 'No'))THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' "'//TRIM(OAController(OutAirNum)%Name)//'", invalid field value')
CALL ShowContinueError('...'//trim(cAlphaFields(18))//'="'//trim(AlphArray(18))//'" - valid values are "Yes" or "No".')
ErrorsFound=.TRUE.
END IF
ENDIF
ELSE ! Invalid field 16
CALL ShowSevereError(TRIM(CurrentModuleObject)//' "'//TRIM(OAController(OutAirNum)%Name)//'", invalid field value')
CALL ShowContinueError('...'//trim(cAlphaFields(16))//'="'//trim(AlphArray(16))//'" - valid values are "Yes" or "No".')
ErrorsFound=.TRUE.
IF (NumAlphas >= 18) THEN
IF(.not. SameString(AlphArray(18), 'Yes') .and. .not. SameString(AlphArray(18), 'No'))THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//' "'//TRIM(OAController(OutAirNum)%Name)//'", invalid field value')
CALL ShowContinueError('...'//trim(cAlphaFields(18))//'="'//trim(AlphArray(18))//'" - valid values are "Yes" or "No".')
ErrorsFound=.TRUE.
END IF
ENDIF
END IF
IF(NumAlphas .GT. 18)THEN
IF(.NOT. lAlphaBlanks(19))THEN
IF(SameString(AlphArray(19), 'BypassWhenWithinEconomizerLimits'))THEN
OAController(OutAirNum)%HeatRecoveryBypassControlType = BypassWhenWithinEconomizerLimits
ELSE IF(SameString(AlphArray(19), 'BypassWhenOAFlowGreaterThanMinimum'))THEN
OAController(OutAirNum)%HeatRecoveryBypassControlType = BypassWhenOAFlowGreaterThanMinimum
ELSE
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(19))//'="'//trim(AlphArray(19))//'".')
CALL ShowContinueError('...assuming "BypassWhenWithinEconomizerLimits" and the simulation continues.')
OAController(OutAirNum)%HeatRecoveryBypassControlType = BypassWhenWithinEconomizerLimits
END IF
END IF
END IF
IF(SameString(AlphArray(16),'Yes') .AND. OAController(OutAirNum)%Econo .EQ. NoEconomizer)THEN
CALL ShowWarningError(TRIM(OAController(OutAirNum)%ControllerType)//' "' &
//TRIM(OAController(OutAirNum)%Name)//'"')
CALL ShowContinueError('...Economizer operation must be enabled when '//TRIM(cAlphaFields(16))//' is set to YES.')
CALL ShowContinueError('...The high humidity control option will be disabled and the simulation continues.')
END IF
! Mangesh code to fix CR 8225 - 09/14/2010
IF ((NumControllerLists > 0) .AND. (NumOASystems > 0)) THEN
OALp: DO AirLoopNumber = 1, NumPrimaryAirSys
DesSupplyVolFlowRate = AirLoopFlow(AirLoopNumber)%DesSupply / StdRhoAir
DO BranchNum = 1, PrimaryAirSystem(AirLoopNumber)%NumBranches
DO CompNum = 1, PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%TotalComponents
DO ControllerListNum = 1, NumControllerLists
ControllerNum = ControllerLists(ControllerListNum)%NumControllers
IF (ControllerNum > 0) THEN
DO Num = 1, ControllerNum
DO SysNum = 1, NumOASystems
IF (SameString(PrimaryAirSystem(AirLoopNumber)%Branch(BranchNum)%Comp(CompNum)%Name,&
OutsideAirSys(SysNum)%Name)) THEN
IF (SameString(OutsideAirSys(SysNum)%ControllerListName,ControllerLists(ControllerListNum)%Name)) THEN
IF (SameString(OAController(OutAirNum)%Name,ControllerLists(ControllerListNum)%ControllerName(Num))) THEN
IF ((OAController(OutAirNum)%MinOA-DesSupplyVolFlowRate) > .0001d0) THEN
CALL ShowWarningError('Minimum outside air flow rate for OA Controller "' // &
TRIM(OAController(OutAirNum)%Name) // &
'" is greater than maximum supply flow rate for Air Loop "'// &
TRIM(PrimaryAirSystem(AirLoopNumber)%Name)//'"')
CALL ShowContinueError('...Min for OA Controller=['// &
TRIM(RoundSigDigits(OAController(OutAirNum)%MinOA,6))//'], Max Supply Flow Rate=['// &
TRIM(RoundSigDigits(DesSupplyVolFlowRate,6))//'].')
Call ShowContinueError('...Minimum outside air flow ' &
// 'rate will be reset to equal maximum supply flow rate')
OAController(OutAirNum)%MinOA = DesSupplyVolFlowRate
ELSEIF ((OAController(OutAirNum)%MinOA-DesSupplyVolFlowRate) > 0.0d0) THEN
OAController(OutAirNum)%MinOA = DesSupplyVolFlowRate
ENDIF
Exit OALp ! Found and checked
END IF
ENDIF
ENDIF
END DO
END DO
ENDIF
END DO
END DO
END DO
END DO OALp
ENDIF
! add applicable faults identifier to avoid string comparison at each time step
! loop through each fault for each OA controller
DO i = 1, NumFaults
IF (Faults(i)%ControllerTypeEnum /= iController_AirEconomizer) CYCLE
IF (SameString(OAController(OutAirNum)%Name, Faults(i)%ControllerName)) THEN
Faults(i)%ControllerID = OutAirNum
ENDIF
ENDDO
END DO ! LOOP FOR OutAirNum
IF (ErrorsFound) THEN
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
DEALLOCATE(lNumericBlanks)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' inputs.')
ENDIF
END IF
GetOAControllerInputFlag=.false.
! Find the maximum number of zones attached to any air loop, used for mechanical ventilation objects
MaxNumAirLoopZones = 0
DO NumofAirLoop = 1, NumPrimaryAirSys
NumAirLoopZones = AirToZoneNodeInfo(NumofAirLoop)%NumZonesCooled + &
AirToZoneNodeInfo(NumofAirLoop)%NumZonesHeated
! NumZonesCooled + NumZonesHeated must be > 0 or Fatal error is issued in SimAirServingZones
MaxNumAirLoopZones = MAX(MaxNumAirLoopZones, NumAirLoopZones) ! Max number of zones on any air loop being simulated
END DO
IF (NumPrimaryAirSys .GT. 0) THEN
ALLOCATE (AirLoopZoneInfo(NumPrimaryAirSys)) ! Defined in DataAirLoop.f90
END IF
! Find the zones attached to each air loop
DO NumofAirLoop = 1, NumPrimaryAirSys
ALLOCATE (AirLoopZoneInfo(NumofAirLoop)%Zone(MaxNumAirLoopZones))
ALLOCATE (AirLoopZoneInfo(NumofAirLoop)%ActualZoneNumber(MaxNumAirLoopZones))
NumAirLoopCooledZones = AirToZoneNodeInfo(NumofAirLoop)%NumZonesCooled
AirLoopZones = NumAirLoopCooledZones
NumAirLoopHeatedZones = AirToZoneNodeInfo(NumofAirLoop)%NumZonesHeated
! Store cooling zone numbers in AirLoopZoneInfo data structure
DO NumAirLoopCooledZonesTemp = 1, NumAirLoopCooledZones
AirLoopZoneInfo(NumofAirLoop)%Zone(NumAirLoopCooledZonesTemp) = &
AirToZoneNodeInfo(NumofAirLoop)%CoolCtrlZoneNums(NumAirLoopCooledZonesTemp)
AirLoopZoneInfo(NumofAirLoop)%ActualZoneNumber(NumAirLoopCooledZonesTemp) = &
ZoneEquipConfig(AirToZoneNodeInfo(NumofAirLoop)%CoolCtrlZoneNums(NumAirLoopCooledZonesTemp))%ActualZoneNum
END DO
! Store heating zone numbers in AirLoopZoneInfo data structure
! Only store zone numbers that aren't already defined as cooling zones above
DO NumAirLoopHeatedZonesTemp = 1,NumAirLoopHeatedZones
ZoneNum = AirToZoneNodeInfo(NumofAirLoop)%HeatCtrlZoneNums(NumAirLoopHeatedZonesTemp)
CommonZone = .FALSE.
DO NumAirLoopCooledZonesTemp = 1, NumAirLoopCooledZones
IF(ZoneNum /= AirToZoneNodeInfo(NumofAirLoop)%CoolCtrlZoneNums(NumAirLoopCooledZonesTemp)) CYCLE
CommonZone = .TRUE.
END DO
IF(.NOT. CommonZone) THEN
AirLoopZones = AirLoopZones + 1
AirLoopZoneInfo(NumofAirLoop)%Zone(AirLoopZones) = ZoneNum
AirLoopZoneInfo(NumofAirLoop)%ActualZoneNumber(AirLoopZones) = ZoneEquipConfig(ZoneNum)%ActualZoneNum
END IF
END DO
AirLoopZoneInfo(NumofAirLoop)%NumZones = AirLoopZones
END DO
! Process Controller:MechanicalVentilation objects
CurrentModuleObject = CurrentModuleObjects(CMO_MechVentilation)
NumVentMechControllers = GetNumObjectsFound(CurrentModuleObject)
IF(NumVentMechControllers .GT. 0) THEN
ALLOCATE(VentilationMechanical(NumVentMechControllers))
DO VentMechNum=1,NumVentMechControllers
CALL GetObjectItem(CurrentModuleObject,VentMechNum,AlphArray,NumAlphas,&
NumArray,NumNums,IOSTAT,NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
MechVentZoneCount = 0
NumGroups = (NumAlphas + NumNums - 5)/3
IF (MOD((NumAlphas + NumNums - 5),3) /= 0) NumGroups=NumGroups+1
VentilationMechanical(VentMechNum)%Name = AlphArray(1)
! Check Controller:MechanicalVentilation object name
ErrorInName = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphArray(1),VentilationMechanical%Name,VentMechNum-1,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound = .TRUE.
IF (IsBlank) AlphArray(1)='xxxxx'
END IF
VentilationMechanical(VentMechNum)%SchName = AlphArray(2)
IF (lAlphaBlanks(2)) THEN
VentilationMechanical(VentMechNum)%SchPtr = ScheduleAlwaysOn
ELSE
VentilationMechanical(VentMechNum)%SchPtr = GetScheduleIndex(AlphArray(2)) ! convert schedule name to pointer
IF (VentilationMechanical(VentMechNum)%SchPtr .EQ. 0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))//'" not found.')
ErrorsFound=.TRUE.
END IF
ENDIF
! Adding new flag for DCV
IF (SameString(AlphArray(3), 'Yes')) THEN
VentilationMechanical(VentMechNum)%DCVFlag = .TRUE.
ELSEIF (SameString(AlphArray(3), 'No') .or. lAlphaBlanks(3)) THEN
VentilationMechanical(VentMechNum)%DCVFlag = .FALSE.
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" invalid value '// &
TRIM(cAlphaFields(3))//'="'//TRIM(AlphArray(3))//'".')
CALL ShowContinueError('...Valid values are "Yes" or "No".')
ErrorsFound=.TRUE.
ENDIF
! System outdoor air method
SELECT CASE (MakeUPPERCase(AlphArray(4)))
CASE ('ZONESUM') ! Simplifily sum the zone OA flow rates
VentilationMechanical(VentMechNum)%SystemOAMethod = SOAM_ZoneSum
CASE ('VRP','VENTILATIONRATEPROCEDURE') ! Ventilation Rate Procedure based on ASHRAE Standard 62.1-2007
IF (SameString(AlphArray(4),'VRP')) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'".')
CALL ShowContinueError('Deprecated value in '//TRIM(cAlphaFields(4))//'="'// &
TRIM(AlphArray(4))//'", using VentilationRateProcedure.')
ENDIF
VentilationMechanical(VentMechNum)%SystemOAMethod = SOAM_VRP
CASE ('IAQP','INDOORAIRQUALITYPROCEDURE') ! Indoor Air Quality Procedure based on ASHRAE Standard 62.1-2007
VentilationMechanical(VentMechNum)%SystemOAMethod = SOAM_IAQP
IF (SameString(AlphArray(4),'IAQP')) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'".')
CALL ShowContinueError('Deprecated value in '//TRIM(cAlphaFields(4))//'="'// &
TRIM(AlphArray(4))//'", using IndoorAirQualityProcedure.')
ENDIF
IF (.NOT. Contaminant%CO2Simulation) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" valid '// &
TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))//'" requires CO2 simulation.')
CALL ShowContinueError('The choice must be Yes for the field Carbon Dioxide Concentration in ZoneAirContaminantBalance')
ErrorsFound=.TRUE.
END IF
CASE ('PROPORTIONALCONTROL') ! Proportional Control based on ASHRAE Standard 62.1-2004
VentilationMechanical(VentMechNum)%SystemOAMethod = SOAM_ProportionalControl
IF (.NOT. Contaminant%CO2Simulation) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" valid '// &
TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))//'" requires CO2 simulation.')
CALL ShowContinueError('The choice must be Yes for the field Carbon Dioxide Concentration in ZoneAirContaminantBalance')
ErrorsFound=.TRUE.
END IF
CASE ('INDOORAIRQUALITYPROCEDUREGENERICCONTAMINANT') ! Indoor Air Quality Procedure based on generic contaminant setpoint
VentilationMechanical(VentMechNum)%SystemOAMethod = SOAM_IAQPGC
IF (.NOT. Contaminant%GenericContamSimulation) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" valid '// &
TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))//'" requires generic contaminant simulation.')
CALL ShowContinueError('The choice must be Yes for the field Generic Contaminant Concentration in ' &
//' ZoneAirContaminantBalance')
ErrorsFound=.TRUE.
END IF
CASE ('INDOORAIRQUALITYPROCEDURECOMBINED') ! Indoor Air Quality Procedure based on both generic contaminant and CO2 setpoint
VentilationMechanical(VentMechNum)%SystemOAMethod = SOAM_IAQPCOM
IF (.NOT. Contaminant%GenericContamSimulation) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" valid '// &
TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))//'" requires generic contaminant simulation.')
CALL ShowContinueError('The choice must be Yes for the field Generic Contaminant Concentration in ' &
//' ZoneAirContaminantBalance')
ErrorsFound=.TRUE.
END IF
IF (.NOT. Contaminant%CO2Simulation) Then
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" valid '// &
TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))//'" requires CO2 simulation.')
CALL ShowContinueError('The choice must be Yes for the field Carbon Dioxide Concentration in ZoneAirContaminantBalance')
ErrorsFound=.TRUE.
END IF
CASE DEFAULT ! If specified incorrectly, show errors
VentilationMechanical(VentMechNum)%SystemOAMethod = SOAM_ZoneSum
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//TRIM(AlphArray(1))//'" incorrect specification for '// &
TRIM(cAlphaFields(4))//', the ZoneSum method will be used.')
!ErrorsFound=.TRUE.
END SELECT
!Zone maximum outdoor air fraction
VentilationMechanical(VentMechNum)%ZoneMaxOAFraction = NumArray(1)
ALLOCATE(VentMechZoneName(NumGroups))
ALLOCATE(DesignSpecOAObjName(NumGroups))
ALLOCATE(DesignSpecOAObjIndex(NumGroups))
ALLOCATE(VentMechZoneOAAreaRate(NumGroups))
ALLOCATE(VentMechZoneOAPeopleRate(NumGroups))
ALLOCATE(VentMechZoneOAFlow(NumGroups))
ALLOCATE(VentMechZoneOAACH(NumGroups))
ALLOCATE(VentMechZoneADEffCooling(NumGroups))
ALLOCATE(VentMechZoneADEffHeating(NumGroups))
ALLOCATE(VentMechZoneADEffSchPtr(NumGroups))
ALLOCATE(VentMechZoneADEffSchName(NumGroups))
ALLOCATE(VentMechZoneSecondaryRecirculation(NumGroups))
ALLOCATE(DesignSpecZoneADObjName(NumGroups))
ALLOCATE(DesignSpecZoneADObjIndex(NumGroups))
VentMechZoneName = ' '
DesignSpecOAObjName = ' '
DesignSpecOAObjIndex = 0
VentMechZoneOAAreaRate = 0.0d0
VentMechZoneOAPeopleRate = 0.0d0
! use defaults for Cooling and Heating Effectiveness
VentMechZoneADEffCooling = 1.0d0
VentMechZoneADEffHeating = 1.0d0
VentMechZoneADEffSchPtr = 0
VentMechZoneADEffSchName = ' '
VentMechZoneSecondaryRecirculation = 0.0d0
DesignSpecZoneADObjName = ' '
DesignSpecZoneADObjIndex = 0
! First time through find the total number of zones requiring mechanical ventilation
! May include duplicate zones. Will check for duplicate zones further down in this subroutine.
DO groupNum = 1, NumGroups
VentMechZoneName(groupNum) = AlphArray((groupNum-1)*3+5)
DO OutAirNum = 1, numOAControllers
IF (OAController(OutAirNum)%VentilationMechanicalName == VentilationMechanical(VentMechNum)%Name .AND. &
VentilationMechanical(VentMechNum)%DCVFlag) THEN
AirLoopControlInfo(OutAirNum)%AirLoopDCVFlag = .TRUE.
ELSE
AirLoopControlInfo(OutAirNum)%AirLoopDCVFlag = .FALSE.
ENDIF
END DO
! Getting OA details from design specification OA object
IF (.not. lAlphaBlanks((groupNum-1)*3+6)) THEN
DesignSpecOAObjName(groupNum) = AlphArray((groupNum-1)*3+6)
ObjIndex = FindItemInList(DesignSpecOAObjName(groupNum),OARequirements%Name,numOARequirements)
DesignSpecOAObjIndex(groupNum) = ObjIndex
IF (ObjIndex > 0) THEN
VentMechZoneOAAreaRate(groupNum) = OARequirements(ObjIndex)%OAFlowPerArea
VentMechZoneOAPeopleRate(groupNum) = OARequirements(ObjIndex)%OAFlowPerPerson
VentMechZoneOAFlow(groupNum) = OARequirements(ObjIndex)%OAFlowPerZone
VentMechZoneOAACH(groupNum) = OARequirements(ObjIndex)%OAFlowACH
!push this check to later...
! IF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_ProportionalControl) THEN
! IF (VentMechZoneOAACH(groupNum) .GT. 0.d0 .OR. VentMechZoneOAFlow(groupNum) .GT. 0.d0) THEN
! CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' = "'// &
! TRIM(VentilationMechanical(VentMechNum)%Name))
! CALL ShowContinueError('Inappropriate outdoor air method for '//TRIM(cAlphaFields((groupNum-1)*3+6))// &
! ' = "'//TRIM(DesignSpecOAObjName(groupNum))//'".')
! CALL ShowContinueError('Since '//TRIM(cAlphaFields(4))//' = "'//TRIM(AlphArray(4))//'", '// &
! 'AirChanges/Hour or Flow/Zone outdoor air methods are not valid. '// &
! TRIM(AlphArray(4))//' will be modeled. Simulation continues.... ')
! ENDIF
! ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
trim(VentilationMechanical(VentMechNum)%Name)//'", invalid')
CALL ShowContinueError('... not found '//trim(cAlphaFields((groupNum-1)*3+6))//'="'// &
TRIM(DesignSpecOAObjName(groupNum))//'".')
ErrorsFound = .TRUE.
ENDIF
ELSE
! check whether a design specification OA object is referenced by a Sizing:Zone object for the current zone
! otherwise generates an error
! IF (DoZoneSizing) THEN
! ObjIndex = FindItemInList(VentMechZoneName(groupNum),ZoneSizingInput%ZoneName,NumZoneSizingInput)
! ObjIndex = ZoneSizingInput(ObjIndex)%ZoneDesignSpecOAIndex
! IF (ObjIndex > 0) THEN
! VentMechZoneOAAreaRate(groupNum) = OARequirements(ObjIndex)%OAFlowPerArea
! VentMechZoneOAPeopleRate(groupNum) = OARequirements(ObjIndex)%OAFlowPerPerson
! VentMechZoneOAFlow(groupNum) = OARequirements(ObjIndex)%OAFlowPerZone
! VentMechZoneOAACH(groupNum) = OARequirements(ObjIndex)%OAFlowACH
! ELSE
! CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
! trim(VentilationMechanical(VentMechNum)%Name)//'", missing')
! CALL ShowContinueError('...blank (required entry)'//trim(cAlphaFields((groupNum-1)*3+6)))
! ErrorsFound = .TRUE.
! ENDIF
ENDIF
! IF (VentMechZoneOAPeopleRate(groupNum) <= 0.0d0 .AND. &
! VentilationMechanical(VentMechNum)%DCVFlag) THEN
! CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(TRIM(VentilationMechanical(VentMechNum)%Name))// &
! '", Zone OA/person rate')
! CALL ShowContinueError('Zone outside air per person rate not set in Design '// &
! 'Specification Outdoor Air Object="'// &
! TRIM(DesignSpecOAObjName(groupNum))//'".')
! ENDIf
!
! IF (VentMechZoneOAAreaRate(groupNum) .LT. 0.0d0) THEN
! CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))// &
! '" has invalid Outdoor Air flow per area specified in object "' &
! // TRIM(OARequirements(DesignSpecOAObjIndex(groupNum))%Name) //'". Value must be >= 0.0.')
! ErrorsFound = .TRUE.
! END IF
! IF (VentMechZoneOAPeopleRate(groupNum) .LT. 0.0d0) THEN
! CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))// &
! '" has invalid Outdoor Air flow per person specified in object "' &
! // TRIM(OARequirements(DesignSpecOAObjIndex(groupNum))%Name) //'". Value must be >= 0.0.')
! ErrorsFound = .TRUE.
! END IF
!
! Get zone air distribution details from design specification Zone Air Distribution object
IF (.not. lAlphaBlanks((groupNum-1)*3+7)) THEN
DesignSpecZoneADObjName(groupNum) = AlphArray((groupNum-1)*3+7)
ObjIndex=FindItemInList(DesignSpecZoneADObjName(groupNum),ZoneAirDistribution%Name,numZoneAirDistribution)
DesignSpecZoneADObjIndex(groupNum) = ObjIndex
IF (ObjIndex > 0) THEN
! found the design specification Zone Air Distribution object
VentMechZoneADEffCooling(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneADEffCooling
VentMechZoneADEffHeating(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneADEffHeating
VentMechZoneSecondaryRecirculation(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneSecondaryRecirculation
VentMechZoneADEffSchName(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneADEffSchName
VentMechZoneADEffSchPtr(groupNum) = GetScheduleIndex(VentMechZoneADEffSchName(groupNum))
ELSE
! Cannot find the design specification Zone Air Distribution object
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(VentilationMechanical(VentMechNum)%Name)//'", invalid')
CALL ShowContinueError('... not found '//trim(cAlphaFields((groupNum-1)*3+7))//'="'// &
TRIM(DesignSpecZoneADObjName(groupNum))//'".')
ErrorsFound = .TRUE.
ENDIF
!push check to later
! ! Error check to see if a single duct air terminal is assigned to a zone that has zone secondary recirculation
!
! IF (VentMechZoneSecondaryRecirculation(groupNum) > 0.0d0) THEN
! ZoneNum = FindItemInList(VentMechZoneName(groupNum),Zone%Name,NumOfZones)
! IF (ZoneNum > 0) THEN
! EquipListIndex = ZoneEquipConfig(ZoneNum)%EquipListIndex
! IF (EquipListIndex > 0) THEN
! EquipLoop: DO EquipListNum = 1, NumofZoneEquipLists
! IF (EquipListNum == EquipListIndex) THEN
! DO EquipNum = 1, ZoneEquipList(EquipListNum)%NumOfEquipTypes
! IF (SameString(ZoneEquipList(EquipListNum)%EquipType(EquipNum),'ZONEHVAC:AIRDISTRIBUTIONUNIT')) THEN
! DO ADUNum = 1, NumAirDistUnits
! IF (SameString(ZoneEquipList(EquipListNum)%EquipName(EquipNum),AirDistUnit(ADUNum)%Name)) THEN
! IF ((AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctVAVReheat) &
! .OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctConstVolReheat) &
! .OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctVAVNoReheat) &
! .OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctVAVReheatVSFan) &
! .OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctCBVAVReheat) &
! .OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctCBVAVNoReheat) &
! .OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctConstVolCooledBeam) &
! .OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == DualDuctVAVOutdoorAir)) THEN
! CALL ShowWarningError(RoutineName// &
! 'A zone secondary recirculation fraction is specified for zone served by ')
! CALL ShowContinueError('...terminal unit "'//TRIM(AirDistUnit(ADUNum)%Name)// &
! '" , that indicates a single path system')
! CALL ShowContinueError('...The zone secondary recirculation for that zone was set to 0.0')
! VentMechZoneSecondaryRecirculation(groupNum) = 0.0d0
! END IF
! Exit EquipLoop
! END IF
! END DO
! END IF
! END DO
! END IF
! END DO EquipLoop
! END IF
! END IF
! END IF
ELSE
! check whether a ZoneAirDistribution object is referenced by the Sizing:Zone object for the current zone
! If not, use defaults which are already set
! IF (DoZoneSizing) THEN
! ObjIndex = FindItemInList(VentMechZoneName(groupNum),ZoneSizingInput%ZoneName,NumZoneSizingInput)
! ObjIndex = ZoneSizingInput(ObjIndex)%ZoneAirDistributionIndex
! IF (ObjIndex > 0) THEN
! VentMechZoneADEffCooling(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneADEffCooling
! VentMechZoneADEffHeating(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneADEffHeating
! VentMechZoneSecondaryRecirculation(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneSecondaryRecirculation
! VentMechZoneADEffSchName(groupNum) = ZoneAirDistribution(ObjIndex)%ZoneADEffSchName
! VentMechZoneADEffSchPtr(groupNum) = GetScheduleIndex(VentMechZoneADEffSchName(groupNum))
! ENDIF
! ENDIF
ENDIF
ZoneNum = FindItemInList(VentMechZoneName(groupNum),Zone%Name,NumOfZones)
IF(ZoneNum .GT. 0)THEN
MechVentZoneCount = MechVentZoneCount + 1
ELSE
ZoneListNum = FindItemInList(VentMechZoneName(groupNum),ZoneList%Name,NumOfZoneLists)
IF(ZoneListNum .GT. 0)THEN
MechVentZoneCount = MechVentZoneCount + ZoneList(ZoneListNum)%NumofZones
ELSE
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(AlphArray(1))//'" invalid '// &
TRIM(cAlphaFields((groupNum-1)*3+5))//' not found.')
CALL ShowContinueError('Missing '//TRIM(cAlphaFields((groupNum-1)*3+5))//' = '&
//TRIM(VentMechZoneName(groupNum)))
ErrorsFound = .TRUE.
END IF
END IF
END DO
VentilationMechanical(VentMechNum)%NumofVentMechZones = MechVentZoneCount
! Now allocate and store unique zone and associated ventilation rate information
ALLOCATE(VentilationMechanical(VentMechNum)%Zone(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneOAAreaRate(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneOAFlow(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneOAACH(MechVentZoneCount))
VentilationMechanical(VentMechNum)%Zone = 0
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName = ' '
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex = 0
VentilationMechanical(VentMechNum)%ZoneOAAreaRate = 0.0d0
VentilationMechanical(VentMechNum)%ZoneOAPeopleRate = 0.0d0
VentilationMechanical(VentMechNum)%ZoneOAFlow = 0.0d0
VentilationMechanical(VentMechNum)%ZoneOAACH = 0.0d0
! added for new DCV, 2/12/2009
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneADEffCooling(MechVentZoneCount))
! Zone air distribution effectiveness in heating mode
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneADEffHeating(MechVentZoneCount))
! Indices to the zone air distribution effectiveness schedules
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneADEffSchPtr(MechVentZoneCount))
! Zone air distribution effectiveness schedule names
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneADEffSchName(MechVentZoneCount))
! Zone air secondary recirculation ratio, added 3/2012
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneSecondaryRecirculation(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(MechVentZoneCount))
ALLOCATE(VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount))
VentilationMechanical(VentMechNum)%ZoneADEffCooling = 1.0d0
VentilationMechanical(VentMechNum)%ZoneADEffHeating = 1.0d0
VentilationMechanical(VentMechNum)%ZoneADEffSchPtr = 0
VentilationMechanical(VentMechNum)%ZoneADEffSchName = ' '
VentilationMechanical(VentMechNum)%ZoneSecondaryRecirculation = 0.0d0
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName = ' '
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex = 0
MechVentZoneCount = 0
! Loop through zone names and list of zone names and store data
DO groupNum = 1, NumGroups
ZoneNum = FindItemInList(VentMechZoneName(groupNum),Zone%Name,NumOfZones)
IF (ZoneNum > 0) THEN
IF (ANY (VentilationMechanical(VentMechNum)%Zone == ZoneNum)) THEN
! Disregard duplicate zone names, show warning and do not store data for this zone
CALL ShowWarningError('Zone name = '//TRIM(VentMechZoneName(groupNum))// &
' for '//TRIM(CurrentModuleObject)//' object = '//TRIM(VentilationMechanical(VentMechNum)%Name))
CALL ShowContinueError('is specified more than once. The first ventilation values specified for this zone will be used')
CALL ShowContinueError('and the rest will be ignored. Simulation will continue..')
ELSE
! Store unique zone names
MechVentZoneCount = MechVentZoneCount + 1
VentilationMechanical(VentMechNum)%Zone(MechVentZoneCount) = ZoneNum
! Populating new temp array to hold design spec OA object for each zone
IF (DesignSpecOAObjName(groupNum) /= blank) THEN
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(MechVentZoneCount) = &
DesignSpecOAObjName(groupNum)
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount) = &
DesignSpecOAObjIndex(groupNum)
VentilationMechanical(VentMechNum)%ZoneOAAreaRate(MechVentZoneCount) = &
VentMechZoneOAAreaRate(groupNum)
VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(MechVentZoneCount) = &
VentMechZoneOAPeopleRate(groupNum)
VentilationMechanical(VentMechNum)%ZoneOAFlow(MechVentZoneCount) = &
VentMechZoneOAFlow(groupNum)
VentilationMechanical(VentMechNum)%ZoneOAACH = &
VentMechZoneOAACH(groupNum)
ELSE
IF (DoZoneSizing) THEN
ObjIndex = &
FindItemInList(VentMechZoneName(groupNum),ZoneSizingInput%ZoneName,NumZoneSizingInput)
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%DesignSpecOAObjName
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%ZoneDesignSpecOAIndex
ObjIndex = VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount)
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneOAAreaRate(MechVentZoneCount) = &
OARequirements(ObjIndex)%OAFlowPerArea
VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(MechVentZoneCount) = &
OARequirements(ObjIndex)%OAFlowPerPerson
VentilationMechanical(VentMechNum)%ZoneOAFlow(MechVentZoneCount) = &
OARequirements(ObjIndex)%OAFlowPerZone
VentilationMechanical(VentMechNum)%ZoneOAACH = &
OARequirements(ObjIndex)%OAFlowACH
ELSE ! use defaults
VentilationMechanical(VentMechNum)%ZoneOAAreaRate(MechVentZoneCount) = 0.0d0
VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(MechVentZoneCount) = 0.00944d0
VentilationMechanical(VentMechNum)%ZoneOAFlow(MechVentZoneCount) = 0.0d0
VentilationMechanical(VentMechNum)%ZoneOAACH = 0.0d0
ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
trim(VentilationMechanical(VentMechNum)%Name)//'", missing')
CALL ShowContinueError('...blank (required entry) - cannot locate in Sizing:Zone for Zone="'// &
trim(VentMechZoneName(groupNum))//'".')
ErrorsFound = .TRUE.
ENDIF
ENDIF
ENDIF
!!!! Zone Air Distribution inputs.
IF (DesignSpecZoneADObjName(groupNum) /= blank) THEN
! new DCV inputs
VentilationMechanical(VentMechNum)%ZoneADEffCooling(MechVentZoneCount) = &
VentMechZoneADEffCooling(groupNum)
VentilationMechanical(VentMechNum)%ZoneADEffHeating(MechVentZoneCount) = &
VentMechZoneADEffHeating(groupNum)
VentilationMechanical(VentMechNum)%ZoneADEffSchPtr(MechVentZoneCount) = &
VentMechZoneADEffSchPtr(groupNum)
VentilationMechanical(VentMechNum)%ZoneADEffSchName(MechVentZoneCount) = &
VentMechZoneADEffSchName(groupNum)
VentilationMechanical(VentMechNum)%ZoneSecondaryRecirculation(MechVentZoneCount) = &
VentMechZoneSecondaryRecirculation(groupNum)
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(MechVentZoneCount) = &
DesignSpecZoneADObjName(groupNum)
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount) = &
DesignSpecZoneADObjIndex(groupNum)
ELSE
IF (DoZoneSizing) THEN
ObjIndex = &
FindItemInList(VentMechZoneName(groupNum),ZoneSizingInput%ZoneName,NumZoneSizingInput)
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%ZoneAirDistEffObjName
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%ZoneAirDistributionIndex
ObjIndex = VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount)
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
trim(VentilationMechanical(VentMechNum)%Name)//'", missing')
CALL ShowContinueError('...blank (required entry) - cannot locate in Sizing:Zone for Zone="'// &
trim(VentMechZoneName(groupNum))//'".')
ErrorsFound = .TRUE.
ENDIF
ENDIF
ENDIF
ENDIF
ELSE
! Not a zone name, must be a zone list
ZoneListNum = FindItemInList(VentMechZoneName(groupNum),ZoneList%Name,NumOfZoneLists)
IF(ZoneListNum .GT. 0)THEN
DO ScanZoneListNum = 1, ZoneList(ZoneListNum)%NumofZones
! check to make sure zone name is unique (not listed more than once)...
ZoneNum = ZoneList(ZoneListNum)%Zone(ScanZoneListNum)
IF (ANY(VentilationMechanical(VentMechNum)%Zone == ZoneNum)) THEN
! Disregard duplicate zone names, show warning and do not store data for this zone
CALL ShowWarningError('Zone name = '//TRIM(Zone(ZoneNum)%Name)// &
' in ZoneList = '//TRIM(VentMechZoneName(groupNum))// &
' for '//TRIM(CurrentModuleObject)//' object = '//TRIM(VentilationMechanical(VentMechNum)%Name))
CALL ShowContinueError('is a duplicate. The first ventilation values specified for this zone will be used ')
CALL ShowContinueError('and the rest will be ignored. The simulation will continue...')
ELSE
! Store data for each zone name from zone list (duplicate zone names accounted for in HeatBalanceManager)
MechVentZoneCount = MechVentZoneCount + 1
VentilationMechanical(VentMechNum)%Zone(MechVentZoneCount) = ZoneNum
! Populating new temp array to hold design spec OA object for each zone
IF (DesignSpecOAObjName(groupNum) /= blank) THEN
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(MechVentZoneCount) = &
DesignSpecOAObjName(groupNum)
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount) = &
DesignSpecOAObjIndex(groupNum)
ObjIndex = VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount)
ELSE
IF (DoZoneSizing) THEN
ObjIndex = &
FindItemInList(Zone(ZoneList(ZoneListNum)%Zone(ScanZoneListNum))%Name, &
ZoneSizingInput%ZoneName,NumZoneSizingInput)
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%DesignSpecOAObjName
VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%ZoneDesignSpecOAIndex
ObjIndex = VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(MechVentZoneCount)
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneADEffCooling(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffCooling
VentilationMechanical(VentMechNum)%ZoneADEffHeating(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffHeating
VentilationMechanical(VentMechNum)%ZoneADEffSchPtr(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffSchPtr
VentilationMechanical(VentMechNum)%ZoneADEffSchName(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffSchName
VentilationMechanical(VentMechNum)%ZoneSecondaryRecirculation(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneSecondaryRecirculation
ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
trim(VentilationMechanical(VentMechNum)%Name)//'", missing')
CALL ShowContinueError('...blank (required entry) - cannot locate in Sizing:Zone for Zone="'// &
trim(Zone(ZoneList(ZoneListNum)%Zone(ScanZoneListNum))%Name)//'".')
ErrorsFound = .TRUE.
ENDIF
ENDIF
ENDIF
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneOAAreaRate(MechVentZoneCount) = &
OARequirements(ObjIndex)%OAFlowPerArea
VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(MechVentZoneCount) = &
OARequirements(ObjIndex)%OAFlowPerPerson
VentilationMechanical(VentMechNum)%ZoneOAFlow(MechVentZoneCount) = &
OARequirements(ObjIndex)%OAFlowPerZone
VentilationMechanical(VentMechNum)%ZoneOAACH(MechVentZoneCount) = &
OARequirements(ObjIndex)%OAFlowACH
! ELSE
! CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
! trim(VentilationMechanical(VentMechNum)%Name)//'", invalid')
! CALL ShowContinueError('... not found '//trim(cAlphaFields((groupNum-1)*3+6))//'="'// &
! TRIM(VentilationMechanical(VentMechNum)%DesignSpecOAObjName(MechVentZoneCount))//'".')
! ErrorsFound = .TRUE.
ENDIF
IF (VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(MechVentZoneCount) /= blank) THEN
! new DCV inputs
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(MechVentZoneCount) = &
DesignSpecZoneADObjName(groupNum)
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount) = &
DesignSpecZoneADObjIndex(groupNum)
ObjIndex = VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount)
ELSE
IF (DoZoneSizing) THEN
ObjIndex = &
FindItemInList(Zone(ZoneList(ZoneListNum)%Zone(ScanZoneListNum))%Name, &
ZoneSizingInput%ZoneName,NumZoneSizingInput)
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%ZoneAirDistEffObjName
VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount) = &
ZoneSizingInput(ObjIndex)%ZoneAirDistributionIndex
ObjIndex = VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjIndex(MechVentZoneCount)
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
trim(VentilationMechanical(VentMechNum)%Name)//'", missing')
CALL ShowContinueError('...blank (required entry) - cannot locate in Sizing:Zone for Zone="'// &
trim(Zone(ZoneList(ZoneListNum)%Zone(ScanZoneListNum))%Name)//'".')
ErrorsFound = .TRUE.
ENDIF
ENDIF
ENDIF
IF (ObjIndex > 0) THEN
VentilationMechanical(VentMechNum)%ZoneADEffCooling(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffCooling
VentilationMechanical(VentMechNum)%ZoneADEffHeating(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffHeating
VentilationMechanical(VentMechNum)%ZoneADEffSchPtr(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffSchPtr
VentilationMechanical(VentMechNum)%ZoneADEffSchName(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneADEffSchName
VentilationMechanical(VentMechNum)%ZoneSecondaryRecirculation(MechVentZoneCount) = &
ZoneAirDistribution(ObjIndex)%ZoneSecondaryRecirculation
ENDIF
ENDIF
END DO
END IF
END IF
END DO
! Overwrite previous number of zones with number that does not include duplicates
VentilationMechanical(VentMechNum)%NumofVentMechZones = MechVentZoneCount
!moved to after section in initialization where other zones are weeded out.
! !predefined report
! DO jZone = 1, VentilationMechanical(VentMechNum)%NumofVentMechZones
! zoneName = zone(VentilationMechanical(VentMechNum)%Zone(jZone))%name
! CALL PreDefTableEntry(pdchDCVventMechName,zoneName,VentilationMechanical(VentMechNum)%Name)
! CALL PreDefTableEntry(pdchDCVperPerson,zoneName, VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(jZone),6)
! CALL PreDefTableEntry(pdchDCVperArea,zoneName, VentilationMechanical(VentMechNum)%ZoneOAAreaRate(jZone),6)
!
! ! added for new DCV inputs
! CALL PreDefTableEntry(pdchDCVZoneADEffCooling,zoneName, VentilationMechanical(VentMechNum)%ZoneADEffCooling(jZone),2)
! CALL PreDefTableEntry(pdchDCVZoneADEffHeating,zoneName, VentilationMechanical(VentMechNum)%ZoneADEffHeating(jZone),2)
! CALL PreDefTableEntry(pdchDCVZoneADEffSchName,zoneName, &
! GetScheduleName(VentilationMechanical(VentMechNum)%ZoneADEffSchPtr(jZone)))
! END DO
DEALLOCATE(VentMechZoneName)
DEALLOCATE(DesignSpecOAObjName)
DEALLOCATE(DesignSpecOAObjIndex)
DEALLOCATE(VentMechZoneOAAreaRate)
DEALLOCATE(VentMechZoneOAPeopleRate)
DEALLOCATE(VentMechZoneADEffCooling)
DEALLOCATE(VentMechZoneADEffHeating)
DEALLOCATE(VentMechZoneADEffSchPtr)
DEALLOCATE(VentMechZoneADEffSchName)
DEALLOCATE(VentMechZoneOAFlow)
DEALLOCATE(VentMechZoneOAACH)
DEALLOCATE(DesignSpecZoneADObjName)
DEALLOCATE(DesignSpecZoneADObjIndex)
DEALLOCATE(VentMechZoneSecondaryRecirculation)
END DO
DO VentMechNum=1,NumVentMechControllers
DO jZone=1,VentilationMechanical(VentMechNum)%NumofVentMechZones
IF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_ProportionalControl) THEN
IF (VentilationMechanical(VentMechNum)%ZoneOAACH(jZone) .GT. 0.d0 .OR. &
VentilationMechanical(VentMechNum)%ZoneOAFlow(jZone) .GT. 0.d0) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'//trim(VentilationMechanical(VentMechNum)%Name)// &
'", inappropriate outdoor air method')
CALL ShowContinueError('Inappropriate method for Design Specification Outdoor Air Object Name="'// &
TRIM(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(jZone))//'".')
CALL ShowContinueError('For Zone="'//trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//'".')
CALL ShowContinueError('Since System Outdoor Air Method="ProportionalControl", '// &
'AirChanges/Hour or Flow/Zone outdoor air methods are not valid. Simulation continues.... ')
ENDIF
ENDIF
! Error check to see if a single duct air terminal is assigned to a zone that has zone secondary recirculation
IF (VentilationMechanical(VentMechNum)%ZoneSecondaryRecirculation(jZone) > 0.0d0) THEN
ZoneNum = VentilationMechanical(VentMechNum)%Zone(jZone)
IF (ZoneNum > 0) THEN
EquipListIndex = ZoneEquipConfig(ZoneNum)%EquipListIndex
IF (EquipListIndex > 0) THEN
EquipLoop: DO EquipListNum = 1, NumofZoneEquipLists
IF (EquipListNum == EquipListIndex) THEN
DO EquipNum = 1, ZoneEquipList(EquipListNum)%NumOfEquipTypes
IF (SameString(ZoneEquipList(EquipListNum)%EquipType(EquipNum),'ZONEHVAC:AIRDISTRIBUTIONUNIT')) THEN
DO ADUNum = 1, NumAirDistUnits
IF (SameString(ZoneEquipList(EquipListNum)%EquipName(EquipNum),AirDistUnit(ADUNum)%Name)) THEN
IF ((AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctVAVReheat) &
.OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctConstVolReheat) &
.OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctVAVNoReheat) &
.OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctVAVReheatVSFan) &
.OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctCBVAVReheat) &
.OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctCBVAVNoReheat) &
.OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == SingleDuctConstVolCooledBeam) &
.OR. (AirDistUnit(ADUNum)%EquipType_Num(EquipNum) == DualDuctVAVOutdoorAir)) THEN
CALL ShowWarningError(trim(CurrentModuleObject)//'="'// &
trim(VentilationMechanical(VentMechNum)%Name)//'", inappropriate use of Zone secondary recirculation')
CALL ShowContinueError('A zone secondary recirculation fraction is specified for zone served by ')
CALL ShowContinueError('...terminal unit "'//TRIM(AirDistUnit(ADUNum)%Name)// &
'" , that indicates a single path system')
CALL ShowContinueError('For Zone="'// &
trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//'".')
CALL ShowContinueError('...The zone secondary recirculation for that zone was set to 0.0')
VentilationMechanical(VentMechNum)%ZoneSecondaryRecirculation(jZone) = 0.0d0
END IF
Exit EquipLoop
END IF
END DO
END IF
END DO
END IF
END DO EquipLoop
END IF
END IF
END IF
IF (VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(jZone) == blank) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(VentilationMechanical(VentMechNum)%Name)// &
'", Design Specification Outdoor Air Object Name blank')
CALL ShowContinueError('For Zone="'//trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//'".')
CALL ShowContinueError('This field either needs to be filled in in this object or Sizing:Zone object.')
CALL ShowContinueError('For this run, default values for these fields will be used.')
! ErrorsFound=.true.
ENDIF
! IF (VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(jZone) == blank) THEN
! CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(VentilationMechanical(VentMechNum)%Name)// &
! '", Design Specification Zone Air Distribution Object Name blank')
! CALL ShowContinueError('For Zone="'//trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//'".')
! CALL ShowContinueError('This field either needs to be filled in in this object or Sizing:Zone object.')
! ErrorsFound=.true.
! ENDIF
IF (VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(jZone) <= 0.0d0 .AND. &
VentilationMechanical(VentMechNum)%DCVFlag) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(VentilationMechanical(VentMechNum)%Name)// &
'", Zone OA/person rate')
CALL ShowContinueError('For Zone="'//trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//'".')
CALL ShowContinueError('Zone outside air per person rate not set in Design '// &
'Specification Outdoor Air Object="'// &
TRIM(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(jZone))//'".')
ENDIf
IF (VentilationMechanical(VentMechNum)%ZoneOAAreaRate(jZone) .LT. 0.0d0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(VentilationMechanical(VentMechNum)%Name)// &
'", invalid Outdoor Air flow per area')
CALL ShowContinueError('For Zone="'//trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//'".')
CALL ShowContinueError('invalid Outdoor Air flow per area specified in object="'// &
TRIM(OARequirements(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(jZone))%Name) // &
'". Value must be >= 0.0.')
ErrorsFound = .TRUE.
END IF
IF (VentilationMechanical(VentMechNum)%ZoneOAPeopleRate(jZone) .LT. 0.0d0) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(VentilationMechanical(VentMechNum)%Name)// &
'", invalid Outdoor Air flow per person')
CALL ShowContinueError('For Zone="'//trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//'".')
CALL ShowContinueError('invalid Outdoor Air flow per person specified in object "'// &
TRIM(OARequirements(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjIndex(jZone))%Name) // &
'". Value must be >= 0.0.')
ErrorsFound = .TRUE.
END IF
ENDDO
ENDDO
! Link OA controller object with mechanical ventilation object
DO OAControllerNum=1,NumOAControllers
OAController(OAControllerNum)%VentMechObjectNum = &
FindItemInList(OAController(OAControllerNum)%VentilationMechanicalName,VentilationMechanical%Name,NumVentMechControllers)
IF(OAController(OAControllerNum)%VentMechObjectNum .EQ. 0 .AND. &
OAController(OAControllerNum)%VentilationMechanicalName .NE. Blank) THEN
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//trim(OAController(OAControllerNum)%VentilationMechanicalName)// &
'", non-match to Controller:OutdoorAir')
CALL ShowContinueError('Invalid specified in Controller:OutdoorAir object = '//TRIM(OAController(OAControllerNum)%Name))
CALL ShowContinueError(TRIM(CurrentModuleObject)//' object name must match the '//TRIM(CurrentModuleObject)// &
' object name specified in Controller:OutdoorAir.')
ErrorsFound = .TRUE.
END IF
END DO
! write to .eio file
Write(OutputFileInits,700)
700 Format('!<Controller:MechanicalVentilation>,Name,Availability Schedule Name,Demand Controlled Ventilation {Yes/No},', &
'System Outdoor Air Method,Zone Maximum Outdoor Air Fraction,Number of Zones,Zone Name,DSOA Name,DSZAD Name')
DO VentMechNum=1,NumVentMechControllers
Write(OutputFileInits,'(A)',ADVANCE='NO') ' Controller:MechanicalVentilation,'// &
trim(VentilationMechanical(VentMechNum)%Name)// &
','//trim(VentilationMechanical(VentMechNum)%SchName)//','
IF (VentilationMechanical(VentMechNum)%DCVFlag) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') 'Yes,'
ELSE
Write(OutputFileInits,'(A)',ADVANCE='NO') 'No,'
ENDIF
IF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_ZoneSum) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') 'ZoneSum,'
ELSEIF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_VRP) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') 'VentilationRateProcedure,'
ELSEIF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_IAQP) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') 'IndoorAirQualityProcedure,'
ELSEIF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_ProportionalControl) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') 'ProportionalControl,'
ELSEIF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_IAQPGC) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') 'IndoorAirQualityGenericContaminant,'
ELSEIF (VentilationMechanical(VentMechNum)%SystemOAMethod == SOAM_IAQPCOM) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') 'IndoorAirQualityProcedureCombined,'
ELSE
Write(OutputFileInits,'(A)',ADVANCE='NO') 'Invalid/Unknown,'
ENDIF
Write(OutputFileInits,'(A)',ADVANCE='NO') trim(RoundSigDigits(VentilationMechanical(VentMechNum)%ZoneMaxOAFraction,2))//','
Write(OutputFileInits,'(A)',ADVANCE='NO') trim(RoundSigDigits(VentilationMechanical(VentMechNum)%NumofVentMechZones))//','
DO jZone=1,VentilationMechanical(VentMechNum)%NumofVentMechZones
IF (jZone < VentilationMechanical(VentMechNum)%NumofVentMechZones) THEN
Write(OutputFileInits,'(A)',ADVANCE='NO') trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//','// &
trim(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(jZone))//','// &
trim(VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(jZone))//','
ELSE
Write(OutputFileInits,'(A)') trim(Zone(VentilationMechanical(VentMechNum)%Zone(jZone))%Name)//','// &
trim(VentilationMechanical(VentMechNum)%ZoneDesignSpecOAObjName(jZone))//','// &
trim(VentilationMechanical(VentMechNum)%ZoneDesignSpecADObjName(jZone))
ENDIF
ENDDO
ENDDO
END IF ! Number of Mechanical Ventilation Objects > 0
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
DEALLOCATE(lNumericBlanks)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found when getting '//TRIM(CurrentModuleObject)//' inputs.')
END IF
RETURN
END SUBROUTINE GetOAControllerInputs