SUBROUTINE GetAirflowNetworkInput
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Aug. 2003
! MODIFIED Aug. 2005
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads inputs of air distribution system
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindIteminList, GetObjectItemNum, VerifyName, &
GetObjectDefMaxArgs,SameString, MakeUPPERCase
USE HVACHXAssistedCoolingCoil, ONLY: VerifyHeatExchangerParent
USE DataHeatBalance, ONLY: People, TotPeople
USE ThermalComfort, ONLY: ThermalComfortData
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=1), PARAMETER :: Blank=' '
CHARACTER(len=*), PARAMETER :: fmta='(A)'
CHARACTER(len=*), PARAMETER :: RoutineName='GetAirflowNetworkInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER i,n,j
INTEGER count
LOGICAL NodeFound, CompFound,ErrorsFound, found, FanErrorFound,NodeFound1,NodeFound2
Integer NumAPL
LOGICAL IsNotOK, IsBlank
CHARACTER (len=MaxNameLength) CompName(2)
CHARACTER(len=MaxNameLength) SimAirNetworkKey
LOGICAL SimObjectError
CHARACTER(len=MaxNameLength * 2) :: StringOut
INTEGER ZoneNum
Integer FanIndex, FanType_Num
! Declare variables used in this subroutine for debug purpose
LOGICAL AirflowNetworkInitFlag
INTEGER, ALLOCATABLE, DIMENSION(:) :: ZoneCheck
INTEGER, ALLOCATABLE, DIMENSION(:) :: ZoneBCCheck
LOGICAL SurfaceFound
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
CHARACTER(Len=MaxNameLength) :: CurrentModuleObject
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: Alphas ! Alpha input items for object
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(Len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
REAL(r64), ALLOCATABLE, DIMENSION(:) :: Numbers ! Numeric input items for object
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
INTEGER :: MaxNums=0 ! Maximum number of numeric input fields
INTEGER :: MaxAlphas=0 ! Maximum number of alpha input fields
INTEGER :: TotalArgs=0 ! Total number of alpha and numeric arguments (max) for a
! Set the maximum numbers of input fields
CALL GetObjectDefMaxArgs('AirflowNetwork:SimulationControl',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:Zone',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:Surface',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:ReferenceCrackConditions',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:Surface:Crack',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:Surface:EffectiveLeakageArea',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:Component:DetailedOpening',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:Component:SimpleOpening',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:Component:ZoneExhaustFan',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:ExternalNode',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:WindPressureCoefficientArray',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:MultiZone:WindPressureCoefficientValues',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Node',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Component:Leak',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Component:LeakageRatio',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Component:Duct',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Component:Fan',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Component:Coil',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Component:TerminalUnit',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Component:ConstantPressureDrop',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
CALL GetObjectDefMaxArgs('AirflowNetwork:Distribution:Linkage',TotalArgs,NumAlphas,NumNumbers)
MaxNums=MAX(MaxNums,NumNumbers)
MaxAlphas=MAX(MaxAlphas,NumAlphas)
ALLOCATE(Alphas(MaxAlphas))
Alphas=' '
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(Numbers(MaxNums))
Numbers=0.0d0
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.true.
ErrorsFound = .FALSE.
AirflowNetworkInitFlag = .FALSE.
! *** Read AirflowNetwork simulation parameters
CurrentModuleObject='AirflowNetwork:SimulationControl'
NumAirflowNetwork = GetNumObjectsFound(CurrentModuleObject)
if (NumAirflowNetwork .EQ. 0) then
SimulateAirflowNetwork = AirflowNetworkControlSimple
WRITE(OutputFileInits,110)
WRITE(OutputFileInits,120) 'NoMultizoneOrDistribution'
Return
end if
if (NumAirflowNetwork .GT. 1) then
CALL ShowFatalError(RoutineName//'Currently only one ("1") '//TRIM(CurrentModuleObject)// &
' object per simulation is allowed.')
end if
SimObjectError=.false.
CALL GetObjectItem(CurrentModuleObject,NumAirflowNetwork,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
AirflowNetworkSimu%AirflowNetworkSimuName = Alphas(1)
AirflowNetworkSimu%Control = Alphas(2)
AirflowNetworkSimu%WPCCntr = Alphas(3)
AirflowNetworkSimu%CpArrayName = Alphas(4)
AirflowNetworkSimu%HeightOption = Alphas(5)
AirflowNetworkSimu%BldgType = Alphas(6)
! Find a flag for possible combination of vent and distribution system
SELECT CASE(MakeUPPERCase(AirflowNetworkSimu%Control))
CASE ('NOMULTIZONEORDISTRIBUTION')
SimulateAirflowNetwork = AirflowNetworkControlSimple
SimAirNetworkKey = 'NoMultizoneOrDistribution'
CASE ('MULTIZONEWITHOUTDISTRIBUTION')
SimulateAirflowNetwork = AirflowNetworkControlMultizone
SimAirNetworkKey = 'MultizoneWithoutDistribution'
CASE ('MULTIZONEWITHDISTRIBUTIONONLYDURINGFANOPERATION')
SimulateAirflowNetwork = AirflowNetworkControlSimpleADS
SimAirNetworkKey = 'MultizoneWithDistributionOnlyDuringFanOperation'
CASE ('MULTIZONEWITHDISTRIBUTION')
SimulateAirflowNetwork = AirflowNetworkControlMultiADS
SimAirNetworkKey = 'MultizoneWithDistribution'
CASE DEFAULT ! Error
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'The entered choice for '//TRIM(cAlphaFields(2))//' is not valid = "'//AirflowNetworkSimu%Control//'"')
CALL ShowContinueError('Valid choices are "NO MULTIZONE OR DISTRIBUTION",'// &
'"MULTIZONE WITH DISTRIBUTION ONLY DURING FAN OPERATION"')
CALL ShowContinueError('"MULTIZONE WITH DISTRIBUTION", or "MULTIZONE WITHOUT DISTRIBUTION"')
CALL ShowContinueError('..specified in '//TRIM(CurrentModuleObject)//' '//TRIM(cAlphaFields(1))//' = '// &
Trim(AirflowNetworkSimu%AirflowNetworkSimuName))
ErrorsFound=.true.
END SELECT
! Check the number of primary air loops
if (SimulateAirFlowNetwork == AirflowNetworkControlSimpleADS .or. SimulateAirFlowNetwork == AirflowNetworkControlMultiADS) THEN
NumAPL = GetNumObjectsFound('AirLoopHVAC')
if (NumAPL .NE. 1) then
if (NumAPL .EQ. 0) then
CALL ShowSevereError(RoutineName//'No AirLoopHVAC is found when '// TRIM(cAlphaFields(2))// &
' = '//Trim(SimAirNetworkKey))
CALL ShowContinueError('Please select a choice of MultizoneWithoutDistribution for '//TRIM(cAlphaFields(2)))
else
CALL ShowSevereError(RoutineName//'More AirLoopHVACs are found. Currently only one ("1") AirLoopHVAC'// &
' object per simulation is allowed when using AirflowNetwork Distribution Systems')
end if
CALL ShowFatalError(RoutineName//'Errors found getting '//TRIM(CurrentModuleObject)//' object.'// &
' Previous error(s) cause program termination.')
end if
end if
WRITE(OutputFileInits,110)
WRITE(OutputFileInits,120) Trim(SimAirNetworkKey)
110 Format('! <AirflowNetwork Model:Control>, No Multizone or Distribution/Multizone with Distribution/', &
'Multizone without Distribution/Multizone with Distribution only during Fan Operation')
120 Format('AirflowNetwork Model:Control,',A)
! Check whether there are any objects from infiltration, ventilation, mixing and cross mixing
If (SimulateAirflowNetwork == AirflowNetworkControlSimple .or. SimulateAirflowNetwork == AirflowNetworkControlSimpleADS) then
If (TotInfiltration+TotVentilation+TotMixing+TotCrossMixing+TotZoneAirBalance+GetNumObjectsFound('ZoneEarthtube')+ &
GetNumObjectsFound('ZoneThermalChimney')+GetNumObjectsFound('ZoneCoolTower:Shower') == 0) then
CALL ShowWarningError(RoutineName//TRIM(cAlphaFields(2))//' = "'//Trim(SimAirNetworkKey)//'".')
CALL ShowContinueError('..but there are no Infiltration, Ventilation, Mixing, Cross Mixing or ZoneAirBalance objects.'// &
' The simulation continues...')
End If
end if
! Check whether a user wants to perform SIMPLE calculation only or not
If (SimulateAirflowNetwork == AirflowNetworkControlSimple) Return
If (SimulateAirflowNetwork == AirflowNetworkControlMultizone .or. SimulateAirflowNetwork == AirflowNetworkControlMultiADS) then
If (TotInfiltration > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneInfiltration:* objects are present.')
CALL ShowContinueError('..ZoneInfiltration objects will not be simulated.')
End If
If (TotVentilation > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneVentilation:* objects are present.')
CALL ShowContinueError('..ZoneVentilation objects will not be simulated.')
End If
If (TotMixing > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneMixing objects are present.')
CALL ShowContinueError('..ZoneMixing objects will not be simulated.')
End If
If (TotCrossMixing > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneCrossMixing objects are present.')
CALL ShowContinueError('..ZoneCrossMixing objects will not be simulated.')
End If
If (TotZoneAirBalance > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneAirBalance:OutdoorAir objects are present.')
CALL ShowContinueError('..ZoneAirBalance:OutdoorAir objects will not be simulated.')
End If
If (GetNumObjectsFound('ZoneEarthtube') > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneEarthtube objects are present.')
CALL ShowContinueError('..ZoneEarthtube objects will not be simulated.')
End If
If (GetNumObjectsFound('ZoneThermalChimney') > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneThermalChimney objects are present.')
CALL ShowContinueError('..ZoneThermalChimney objects will not be simulated.')
End If
If (GetNumObjectsFound('ZoneCoolTower:Shower') > 0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, ')
CALL ShowContinueError('..Specified '//TRIM(cAlphaFields(2))//' = "'// &
TRIM(SimAirNetworkKey)//'" and ZoneCoolTower:Shower objects are present.')
CALL ShowContinueError('..ZoneCoolTower:Shower objects will not be simulated.')
End If
End If
if (SameString(AirflowNetworkSimu%WPCCntr,'Input')) then
AirflowNetworkSimu%iWPCCntr=iWPCCntr_Input
if (lAlphaBlanks(4)) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// TRIM(cAlphaFields(3))//' = INPUT.')
CALL ShowContinueError('..'//TRIM(cAlphaFields(4))//' was not entered.')
ErrorsFound=.true.
SimObjectError=.true.
end if
if (lAlphaBlanks(5)) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// TRIM(cAlphaFields(3))//' = INPUT.')
CALL ShowContinueError('..'//TRIM(cAlphaFields(5))//' was not entered.')
ErrorsFound=.true.
SimObjectError=.true.
Else
if (.NOT. (SameString(AirflowNetworkSimu%HeightOption,'ExternalNode') .or. &
SameString(AirflowNetworkSimu%HeightOption,'OpeningHeight'))) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(5))//' = '// &
TRIM(Alphas(5))//' is invalid.')
CALL ShowContinueError('Valid choices are ExternalNode or OpeningHeight. '//TRIM(CurrentModuleObject)//': '// &
TRIM(cAlphaFields(1))//' = '//TRIM(AirflowNetworkSimu%AirflowNetworkSimuName))
ErrorsFound=.true.
SimObjectError=.true.
end if
end if
! if (AirflowNetworkSimu%BldgType /= ' ') then
! CALL ShowMessage('GetAirflowNetworkInput: AirflowNetwork Wind Pressure Coefficient Type = INPUT.'// &
! ' Building type = '//TRIM(AirflowNetworkSimu%BldgType)//' was entered but will not be used.')
! AirflowNetworkSimu%BldgType = ' '
! end if
else if (SameString(AirflowNetworkSimu%WPCCntr,'SurfaceAverageCalculation')) then
AirflowNetworkSimu%iWPCCntr=iWPCCntr_SurfAvg
if (.NOT. lAlphaBlanks(4)) then
AirflowNetworkSimu%CpArrayName = ' '
! CALL ShowWarningError('GetAirflowNetworkInput: AirflowNetwork Wind Pressure Coefficient Type '// &
! '= SURFACE-AVERAGE CALCULATION.'// &
! ' CP ARRAY NAME was entered but will not be used. The simulation continues...')
end if
if (.NOT. (SameString(AirflowNetworkSimu%BldgType,'LowRise') .or. &
SameString(AirflowNetworkSimu%BldgType,'HighRise'))) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(6))//' = '// &
TRIM(Alphas(6))//' is invalid.')
CALL ShowContinueError('Valid choices are LowRise or HighRise. '//TRIM(CurrentModuleObject)//': '// &
TRIM(cAlphaFields(1))//' = '//TRIM(AirflowNetworkSimu%AirflowNetworkSimuName))
ErrorsFound=.true.
SimObjectError=.true.
end if
else
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(3))//' = '// &
TRIM(AirflowNetworkSimu%WPCCntr)//' is not valid.')
CALL ShowContinueError('Valid choices are Input or SurfaceAverageCalculation. '//TRIM(CurrentModuleObject)//' = ' &
//TRIM(AirflowNetworkSimu%AirflowNetworkSimuName))
ErrorsFound=.true.
SimObjectError=.true.
end if
AirflowNetworkSimu%InitType = Alphas(7)
if (SameString(AirflowNetworkSimu%InitType,'LinearInitializationMethod')) then
AirflowNetworkSimu%InitFlag = 0
Else IF (SameString(AirflowNetworkSimu%InitType,'ZeroNodePressures')) then
AirflowNetworkSimu%InitFlag = 1
Else IF (SameString(AirflowNetworkSimu%InitType,'0')) then
AirflowNetworkSimu%InitFlag = 0
Else IF (SameString(AirflowNetworkSimu%InitType,'1')) then
AirflowNetworkSimu%InitFlag = 1
Else
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
' '//TRIM(cAlphaFields(7))//' = '//TRIM(Alphas(7))//' is invalid.')
CALL ShowContinueError('Valid choices are LinearInitializationMethod or ZeroNodePressures. '// &
TRIM(CurrentModuleObject)//' = '//TRIM(AirflowNetworkSimu%AirflowNetworkSimuName))
ErrorsFound=.true.
SimObjectError=.true.
End If
IF (SimObjectError) THEN
CALL ShowFatalError(RoutineName//'Errors found getting '//TRIM(CurrentModuleObject)//' object.'// &
' Previous error(s) cause program termination.')
ENDIF
AirflowNetworkSimu%MaxIteration = Numbers(1)
AirflowNetworkSimu%RelTol = Numbers(2)
AirflowNetworkSimu%AbsTol = Numbers(3)
AirflowNetworkSimu%ConvLimit = Numbers(4)
AirflowNetworkSimu%Azimuth = Numbers(5)
AirflowNetworkSimu%AspectRatio = Numbers(6)
AirflowNetworkSimu%MaxPressure = 500.0d0 ! Maximum pressure difference by default
! *** Read AirflowNetwork simulation zone data
CurrentModuleObject='AirflowNetwork:MultiZone:Zone'
AirflowNetworkNumOfZones = GetNumObjectsFound(CurrentModuleObject)
if (AirflowNetworkNumOfZones > 0) then
Allocate(MultizoneZoneData(AirflowNetworkNumOfZones))
ALLOCATE(AirflowNetworkZoneFlag(NumOfZones)) ! AirflowNetwork zone flag
AirflowNetworkZoneFlag = .False.
Do i=1,AirflowNetworkNumOfZones
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneZoneData%ZoneName,i-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneZoneData(i)%ZoneName = Alphas(1) ! Name of Associated EnergyPlus Thermal Zone
If (.NOT. lAlphaBlanks(2)) &
MultizoneZoneData(i)%VentControl = Alphas(2) ! Ventilation Control Mode: "Temperature", "Enthalpy",
! "ASHRAE55ADAPTIVE", "CEN15251AdaptiveComfort,
! "Constant", or "NoVent"
MultizoneZoneData(i)%VentSchName = Alphas(3) ! Name of ventilation temperature control schedule
MultizoneZoneData(i)%OpenFactor = Numbers(1) ! Limit Value on Multiplier for Modulating Venting Open Factor,
! Not applicable if Vent Control Mode = CONSTANT or NOVENT
MultizoneZoneData(i)%LowValueTemp = Numbers(2) ! Lower Value on Inside/Outside Temperature Difference
! for Modulating the Venting Open Factor with temp control
MultizoneZoneData(i)%UpValueTemp = Numbers(3) ! Upper Value on Inside/Outside Temperature Difference
! for Modulating the Venting Open Factor with temp control
MultizoneZoneData(i)%LowValueEnth = Numbers(4) ! Lower Value on Inside/Outside Temperature Difference
! for Modulating the Venting Open Factor with Enthalpy control
MultizoneZoneData(i)%UpValueEnth = Numbers(5) ! Upper Value on Inside/Outside Temperature Difference
! for Modulating the Venting Open Factor with Enthalpy control
MultizoneZoneData(i)%VentCtrNum = VentCtrNum_None
if (SameString(MultizoneZoneData(i)%VentControl,'Temperature')) MultizoneZoneData(i)%VentCtrNum = VentCtrNum_Temp
if (SameString(MultizoneZoneData(i)%VentControl,'Enthalpy')) MultizoneZoneData(i)%VentCtrNum = VentCtrNum_Enth
if (SameString(MultizoneZoneData(i)%VentControl,'Constant')) MultizoneZoneData(i)%VentCtrNum = VentCtrNum_Const
if (SameString(MultizoneZoneData(i)%VentControl,'ASHRAE55Adaptive')) MultizoneZoneData(i)%VentCtrNum = VentCtrNum_ASH55
if (SameString(MultizoneZoneData(i)%VentControl,'CEN15251Adaptive')) MultizoneZoneData(i)%VentCtrNum = VentCtrNum_CEN15251
if (SameString(MultizoneZoneData(i)%VentControl,'NoVent')) MultizoneZoneData(i)%VentCtrNum = VentCtrNum_Novent
If (MultizoneZoneData(i)%VentCtrNum < 4) then
If (NumAlphas == 4 .and. (.NOT. lAlphaBlanks(4))) then
MultizoneZoneData(i)%VentingSchName = Alphas(4)
MultizoneZoneData(i)%VentingSchNum = GetScheduleIndex(MultizoneZoneData(i)%VentingSchName)
If (MultizoneZoneData(i)%VentingSchNum == 0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '//Trim(cAlphaFields(4))//' not found = '// &
Trim(MultizoneZoneData(i)%VentingSchName))
CALL ShowContinueError('..for specified '//Trim(cAlphaFields(1))//' = '//TRIM(Alphas(1)))
ErrorsFound = .true.
end if
End if
Else
MultizoneZoneData(i)%VentingSchName = Blank
MultizoneZoneData(i)%VentingSchNum = 0
End If
end do
Else
CALL ShowSevereError(RoutineName//'For an AirflowNetwork Simulation, '// &
'at least one '//TRIM(CurrentModuleObject)//' object is required but none were found.')
ErrorsFound=.true.
End If
! ==> Zone data validation
Do i=1,AirflowNetworkNumOfZones
! Zone name validation
MultizoneZoneData(i)%ZoneNum = FindIteminList(MultizoneZoneData(i)%ZoneName,Zone%Name,NumOfZones)
IF (MultizoneZoneData(i)%ZoneNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, invalid '//TRIM(cAlphaFields(1))//' given.')
CALL ShowContinueError('..invalid '//TRIM(cAlphaFields(1))//' = "' //TRIM(MultizoneZoneData(i)%ZoneName)//'"')
ErrorsFound=.true.
Else
AirflowNetworkZoneFlag(MultizoneZoneData(i)%ZoneNum) = .True.
MultizoneZoneData(i)%Height = Zone(MultizoneZoneData(i)%ZoneNum)%CENTROID%Z ! Nodal height
END IF
if (MultizoneZoneData(i)%VentCtrNum == VentCtrNum_None) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, invalid '//TRIM(cAlphaFields(2))//' = ' &
//TRIM(MultizoneZoneData(i)%VentControl))
CALL ShowContinueError('Valid choices are Temperature, Enthalpy, Constant, or NoVent')
CALL ShowContinueError('.. in '//TRIM(cAlphaFields(1))//' = "' //TRIM(MultizoneZoneData(i)%ZoneName)//'"')
ErrorsFound=.true.
end if
if (SameString(MultizoneZoneData(i)%VentControl,'Temperature') .or. &
SameString(MultizoneZoneData(i)%VentControl,'Enthalpy')) then
! .or. &
!SameString(MultizoneZoneData(i)%VentControl,'ASHRAE55Adaptive') .or. &
!SameString(MultizoneZoneData(i)%VentControl,'CEN15251Adaptive')) then
MultizoneZoneData(i)%VentSchNum = GetScheduleIndex(MultizoneZoneData(i)%VentSchName)
if (MultizoneZoneData(i)%VentSchName == Blank) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'No '//TRIM(cAlphaFields(3))//' was found, but is required when '//TRIM(cAlphaFields(2))// &
' is Temperature or Enthalpy.')
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName)// &
'", with '//TRIM(cAlphaFields(2))//' = "'//TRIM(MultizoneZoneData(i)%VentControl)//'"')
ErrorsFound=.true.
elseif (MultizoneZoneData(i)%VentSchNum == 0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, invalid '//Trim(cAlphaFields(3))//', '// &
' required when '//TRIM(cAlphaFields(2))//' is Temperature or Enthalpy.')
CALL ShowContinueError('..'//TRIM(cAlphaFields(3))//' in error = '//TRIM(MultizoneZoneData(i)%VentSchName))
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName)//'", with '// &
TRIM(cAlphaFields(2))//' = "'//TRIM(MultizoneZoneData(i)%VentControl)//'"')
ErrorsFound = .true.
end if
else
MultizoneZoneData(i)%VentSchNum = GetScheduleIndex(MultizoneZoneData(i)%VentSchName)
IF (MultizoneZoneData(i)%VentSchNum > 0) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(3))// &
' not required, when '//TRIM(cAlphaFields(2))//' is neither Temperature nor Enthalpy.')
CALL ShowContinueError('..'//TRIM(cAlphaFields(3))//' specified = '//TRIM(MultizoneZoneData(i)%VentSchName))
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName)//'", with '//&
TRIM(cAlphaFields(2))//' = "'//TRIM(MultizoneZoneData(i)%VentControl)//'"')
MultizoneZoneData(i)%VentSchNum = 0
MultizoneZoneData(i)%VentSchName = Blank
End if
end if
if (MultizoneZoneData(i)%OpenFactor > 1.0d0 .or. MultizoneZoneData(i)%OpenFactor < 0.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
TRIM(cNumericFields(1))//' is out of range [0.0,1.0]')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneZoneData(i)%OpenFactor,2))// &
', Value will be set to 1.0')
MultizoneZoneData(i)%OpenFactor = 1.0d0
end if
SELECT CASE (MakeUPPERCase(MultizoneZoneData(i)%VentControl))
CASE ('TEMPERATURE') ! checks on Temperature control
if (MultizoneZoneData(i)%LowValueTemp < 0.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
TRIM(cNumericFields(2))//' < 0.0')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneZoneData(i)%LowValueTemp,1))// &
', Value will be set to 0.0')
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName))
MultizoneZoneData(i)%LowValueTemp = 0.0d0
end if
if (MultizoneZoneData(i)%LowValueTemp >= 100.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
TRIM(cNumericFields(2))//' >= 100.0')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneZoneData(i)%LowValueTemp,1))// &
', Value will be reset to 0.0')
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName))
MultizoneZoneData(i)%LowValueTemp = 0.0d0
end if
if (MultizoneZoneData(i)%UpValueTemp <= MultizoneZoneData(i)%LowValueTemp) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
TRIM(cNumericFields(3))//' <= '//Trim(cNumericFields(2)))
CALL ShowContinueError('..Input value for '//TRIM(cNumericFields(3))//' = '// &
TRIM(RoundSigDigits(MultizoneZoneData(i)%UpValueTemp,1))//', Value will be reset to 100.0')
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName))
MultizoneZoneData(i)%UpValueTemp = 100.0d0
end if
CASE ('ENTHALPY') ! checks for Enthalpy control
if (MultizoneZoneData(i)%LowValueEnth < 0.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
TRIM(cNumericFields(4))//' < 0.0')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneZoneData(i)%LowValueEnth,1))// &
', Value will be reset to 0.0')
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName))
MultizoneZoneData(i)%LowValueEnth = 0.0d0
end if
if (MultizoneZoneData(i)%LowValueEnth >= 300000.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
TRIM(cNumericFields(4))//' >= 300000.0')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneZoneData(i)%LowValueEnth,1))// &
', Value will be reset to 0.0.')
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName))
MultizoneZoneData(i)%LowValueEnth = 0.0d0
end if
if (MultizoneZoneData(i)%UpValueEnth <= MultizoneZoneData(i)%LowValueEnth) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
TRIM(cNumericFields(5))//' <= '//TRIM(cNumericFields(4)))
CALL ShowContinueError('..Input value for '//TRIM(cNumericFields(5))//'= '// &
TRIM(RoundSigDigits(MultizoneZoneData(i)%UpValueEnth,1))//', Value will be reset to 300000.0')
CALL ShowContinueError('..for '//TRIM(cAlphaFields(1))//' = "'//TRIM(MultizoneZoneData(i)%ZoneName))
MultizoneZoneData(i)%UpValueEnth = 300000.0d0
end if
CASE ('ASHRAE55ADAPTIVE')
! Check that for the given zone, there is a people object for which ASHRAE 55 calculations are carried out
ZoneNum = MultizoneZoneData(i)%ZoneNum
DO j=1,TotPeople
IF (ZoneNum == People(j)%ZonePtr .and. People(j)%AdaptiveASH55) THEN
MultizoneZoneData(i)%ASH55PeopleInd = j
END IF
END DO
IF (MultizoneZoneData(i)%ASH55PeopleInd==0) THEN
CALL ShowFatalError('ASHRAE55 ventilation control for zone '//TRIM(MultizoneZoneData(i)%ZoneName)// &
' requires a people object with respective model calculations.')
END IF
CASE ('CEN15251ADAPTIVE')
! Check that for the given zone, there is a people object for which CEN-15251 calculations are carried out
ZoneNum = MultizoneZoneData(i)%ZoneNum
DO j=1,TotPeople
IF (ZoneNum == People(j)%ZonePtr .and. People(j)%AdaptiveCEN15251) THEN
MultizoneZoneData(i)%CEN15251PeopleInd = j
EXIT
END IF
END DO
IF (MultizoneZoneData(i)%CEN15251PeopleInd==0) THEN
CALL ShowFatalError('CEN15251 ventilation control for zone '//TRIM(MultizoneZoneData(i)%ZoneName)// &
' requires a people object with respective model calculations.')
END IF
CASE DEFAULT
END SELECT
End Do
! *** Read AirflowNetwork external node
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
! Wind coefficient == Surface-Average does not need inputs of external nodes
CurrentModuleObject='AirflowNetwork:MultiZone:ExternalNode'
AirflowNetworkNumOfExtNode = GetNumObjectsFound(CurrentModuleObject)
If (AirflowNetworkNumOfExtNode > 0) then
Allocate(MultizoneExternalNodeData(AirflowNetworkNumOfExtNode))
Do i=1,AirflowNetworkNumOfExtNode
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneExternalNodeData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneExternalNodeData(i)%Name = Alphas(1) ! Name of external node
MultizoneExternalNodeData(i)%height = Numbers(1) ! Nodal height
If (SameString(AirflowNetworkSimu%HeightOption,'ExternalNode') .AND. lNumericBlanks(1)) Then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object ='//TRIM(Alphas(1))// &
'. The input of ' //TRIM(cNumericFields(1))//' is required, but a blank is found.')
CALL ShowContinueError('The default value is assigned as '//TRIM(RoundSigDigits(Numbers(1),1)))
End If
MultizoneExternalNodeData(i)%ExtNum = AirflowNetworkNumOfZones+i ! External node number
MultizoneExternalNodeData(i)%WPCName = Alphas(2) ! Name of Wind Pressure Coefficient Values Object
End Do
else
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)// &
' object is required but not found when Wind Pressure Coefficient Type = Input.')
ErrorsFound=.true.
end if
end if
! *** Read AirflowNetwork simulation surface data
CurrentModuleObject='AirflowNetwork:MultiZone:Surface'
AirflowNetworkNumOfSurfaces = GetNumObjectsFound(CurrentModuleObject)
if (AirflowNetworkNumOfSurfaces > 0) then
Allocate(MultizoneSurfaceData(AirflowNetworkNumOfSurfaces))
Do i=1,AirflowNetworkNumOfSurfaces
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneSurfaceData%SurfName,i-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
CALL ShowContinueError('..only 1 crack per surface is allowed, opening/crack component = '//TRIM(Alphas(2)))
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneSurfaceData(i)%SurfName = Alphas(1) ! Name of Associated EnergyPlus surface
MultizoneSurfaceData(i)%OpeningName = Alphas(2) ! Name of crack or opening component,
! either simple or detailed large opening, or crack
MultizoneSurfaceData(i)%ExternalNodeName = Alphas(3) ! Name of external node, but not used at WPC="INPUT"
MultizoneSurfaceData(i)%Factor = Numbers(1) ! Crack Actual Value or Window Open Factor for Ventilation
if (MultizoneSurfaceData(i)%Factor > 1.0d0 .or. MultizoneSurfaceData(i)%Factor .LE. 0.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object='//TRIM(MultizoneSurfaceData(i)%SurfName)//', ' &
//TRIM(cNumericFields(1))//' is out of range (0.0,1.0]')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneSurfaceData(i)%Factor,2))// &
', Value will be set to 1.0')
MultizoneSurfaceData(i)%Factor = 1.0d0
end if
! Get input of ventilation control and associated data
If (NumAlphas >= 4) then
! Ventilation Control Mode: "TEMPERATURE", "ENTHALPY",
! "CONSTANT", "ZONELEVEL", "NOVENT", "ADJACENTTEMPERATURE",
! or "ADJACENTENTHALPY"
IF (.not. lAlphaBlanks(4)) MultizoneSurfaceData(i)%VentControl = Alphas(4)
! Name of ventilation temperature control schedule
IF (.not. lAlphaBlanks(5)) MultizoneSurfaceData(i)%VentSchName = Alphas(5)
SELECT CASE (MakeUPPERCase(MultizoneSurfaceData(i)%VentControl))
CASE ('TEMPERATURE')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_Temp
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE ('ENTHALPY')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_Enth
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE ('CONSTANT')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_Const
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE ('ASHRAE55ADAPTIVE')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_ASH55
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE('CEN15251ADAPTIVE')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_CEN15251
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE ('NOVENT')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_Novent
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE ('ZONELEVEL')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_ZoneLevel
MultizoneSurfaceData(i)%IndVentControl = .FALSE.
CASE ('ADJACENTTEMPERATURE')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_AdjTemp
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE ('ADJACENTENTHALPY')
MultizoneSurfaceData(i)%VentSurfCtrNum = VentCtrNum_AdjEnth
MultizoneSurfaceData(i)%IndVentControl = .TRUE.
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'Invalid '//TRIM(cAlphaFields(4)))
CALL ShowContinueError('..'//TRIM(cAlphaFields(1))//' = '//TRIM(MultizoneSurfaceData(i)%SurfName)//', Specified '// &
TRIM(cAlphaFields(4))//' = '//TRIM(Alphas(4)))
CALL ShowContinueError('..The valid choices are "Temperature", "Enthalpy", "Constant", "NoVent", "ZoneLevel", '// &
'"AdjancentTemperature" or "AdjacentEnthalpy"')
ErrorsFound=.true.
END SELECT
End if
MultizoneSurfaceData(i)%ModulateFactor = Numbers(2) ! Limit Value on Multiplier for Modulating Venting Open Factor
MultizoneSurfaceData(i)%LowValueTemp = Numbers(3) ! Lower temperature value for modulation of temperature control
MultizoneSurfaceData(i)%UpValueTemp = Numbers(4) ! Upper temperature value for modulation of temperature control
MultizoneSurfaceData(i)%LowValueEnth = Numbers(5) ! Lower Enthalpy value for modulation of Enthalpy control
MultizoneSurfaceData(i)%UpValueEnth = Numbers(6) ! Lower Enthalpy value for modulation of Enthalpy control
If (MultizoneSurfaceData(i)%VentSurfCtrNum < 4) then
If (.NOT. lAlphaBlanks(6)) then
MultizoneSurfaceData(i)%VentingSchName = Alphas(6) ! Name of ventilation availability schedule
End If
End if
end do
Else
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object is required but not found.')
ErrorsFound=.true.
End if
! ==> Validate AirflowNetwork simulation surface data
NumOfExtNodes = 0
Do i=1,AirflowNetworkNumOfSurfaces
! Check a valid surface defined earlier
MultizoneSurfaceData(i)%SurfNum = FindIteminList(MultizoneSurfaceData(i)%SurfName,Surface%Name,TotSurfaces)
if (MultizoneSurfaceData(i)%SurfNum == 0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, Invalid '//TRIM(cAlphaFields(1))//' given = ' &
//TRIM(MultizoneSurfaceData(i)%SurfName))
ErrorsFound=.true.
cycle
end if
if (.NOT. Surface(MultizoneSurfaceData(i)%SurfNum)%HeatTransSurf) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object')
CALL ShowContinueError('..The surface specified must be a heat transfer surface. Invalid '// &
TRIM(cAlphaFields(1))//' = '//TRIM(MultizoneSurfaceData(i)%SurfName))
ErrorsFound=.true.
cycle
end if
! Ensure an interior surface does not face itself
If (Surface(MultizoneSurfaceData(i)%SurfNum)%ExtBoundCond >= 1) then
! Check the surface is a subsurface or not
If (Surface(MultizoneSurfaceData(i)%SurfNum)%BaseSurf == MultizoneSurfaceData(i)%SurfNum) then
If (MultizoneSurfaceData(i)%SurfNum == Surface(MultizoneSurfaceData(i)%SurfNum)%ExtBoundCond) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object')
CALL ShowContinueError('..The surface facing itself is not allowed. Invalid '// &
TRIM(cAlphaFields(1))//' = '//TRIM(MultizoneSurfaceData(i)%SurfName))
ErrorsFound=.true.
End If
Else
If (Surface(MultizoneSurfaceData(i)%SurfNum)%BaseSurf == &
Surface(Surface(MultizoneSurfaceData(i)%SurfNum)%BaseSurf)%ExtBoundCond) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object')
CALL ShowContinueError('..The base surface facing itself is not allowed. Invalid '// &
TRIM(cAlphaFields(1))//' = '//TRIM(MultizoneSurfaceData(i)%SurfName))
ErrorsFound=.true.
End If
End If
End If
! Ensure zones defined in inside and outside environment are used in the object of AIRFLOWNETWORK:MULTIZONE:ZONE
found = .FALSE.
n = Surface(MultizoneSurfaceData(i)%SurfNum)%Zone
Do j=1,AirflowNetworkNumOfZones
If (MultizoneZoneData(j)%ZoneNum .eq. n) then
Found = .TRUE.
Exit
End if
End do
! find a surface geometry
MultizoneSurfaceData(i)%Height = Surface(MultizoneSurfaceData(i)%SurfNum)%Height
MultizoneSurfaceData(i)%Width = Surface(MultizoneSurfaceData(i)%SurfNum)%Width
MultizoneSurfaceData(i)%CHeight = Surface(MultizoneSurfaceData(i)%SurfNum)%Centroid%Z
If (found) then
MultizoneSurfaceData(i)%NodeNums(1) = j
Else
CALL ShowSevereError(RoutineName// TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(1))//' = '// &
TRIM(MultizoneSurfaceData(i)%SurfName))
CALL ShowContinueError('..Zone for inside surface must be defined in a AirflowNetwork:MultiZone:Zone object. '// &
'Could not find Zone = '//TRIM(Zone(Surface(MultizoneSurfaceData(i)%SurfNum)%Zone)%Name))
ErrorsFound=.true.
Cycle
End if
! Get the number of external surfaces
If (Surface(MultizoneSurfaceData(i)%SurfNum)%ExtBoundCond == ExternalEnvironment) Then
AirflowNetworkNumOfExtSurfaces = AirflowNetworkNumOfExtSurfaces + 1
End If
! Outside face environment
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
n = Surface(MultizoneSurfaceData(i)%SurfNum)%ExtBoundCond
if (n == ExternalEnvironment) then
NumOfExtNodes = NumOfExtNodes+1
if (AirflowNetworkNumOfExtNode > 0) then
found = .False.
do j=1,AirflowNetworkNumOfExtNode
if (SameString(MultizoneSurfaceData(i)%ExternalNodeName,MultizoneExternalNodeData(j)%Name)) then
MultizoneSurfaceData(i)%NodeNums(2) = MultizoneExternalNodeData(j)%ExtNum
found = .True.
Exit
end if
end do
if (.NOT. found) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': Invalid '//TRIM(cAlphaFields(3))//' = ' &
//TRIM(MultizoneSurfaceData(i)%ExternalNodeName))
CALL ShowContinueError('A valid '//TRIM(cAlphaFields(3))//' is required when Wind Pressure Coefficient Type = Input')
ErrorsFound=.true.
end if
else
! MultizoneSurfaceData(i)%NodeNums(2) = AirflowNetworkNumOfZones+NumOfExtNodes
end if
cycle
else
if (n < ExternalEnvironment) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': Invalid '//TRIM(cAlphaFields(1))//' = '// &
TRIM(MultizoneSurfaceData(i)%SurfName))
CALL ShowContinueError('This type of surface (has ground, etc exposure) cannot be used in the AiflowNetwork model.')
ErrorsFound=.true.
end if
end if
found = .FALSE.
Do j=1,AirflowNetworkNumOfZones
If (MultizoneZoneData(j)%ZoneNum .eq. Surface(n)%Zone) then
Found = .TRUE.
Exit
End if
End do
If (found) then
MultizoneSurfaceData(i)%NodeNums(2) = j
Else
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(1))//' = '// &
TRIM(MultizoneSurfaceData(i)%SurfName))
CALL ShowContinueError('..Zone for outside surface must be defined in a AirflowNetwork:MultiZone:Zone object. '// &
'Could not find Zone = '//TRIM(Zone(Surface(MultizoneSurfaceData(i)%SurfNum)%Zone)%Name))
ErrorsFound=.true.
Cycle
End if
End IF
if (SameString(AirflowNetworkSimu%WPCCntr,'SurfaceAverageCalculation')) then
n = Surface(MultizoneSurfaceData(i)%SurfNum)%ExtBoundCond
if (n >= 1) then ! exterior boundary condition is a surface
found = .FALSE.
Do j=1,AirflowNetworkNumOfZones
If (MultizoneZoneData(j)%ZoneNum .eq. Surface(n)%Zone) then
Found = .TRUE.
Exit
End if
End do
If (found) then
MultizoneSurfaceData(i)%NodeNums(2) = j
Else
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(MultizoneSurfaceData(i)%SurfName))
CALL ShowContinueError('..Zone = '//TRIM(Zone(Surface(MultizoneSurfaceData(i)%SurfNum)%Zone)%Name)// &
' is not described in AIRFLOWNETWORK:MULTIZONE:ZONE')
ErrorsFound=.true.
Cycle
End if
End if
end if
end do
! Validate adjacent temperature and Enthalpy control for an interior surface only
Do i=1,AirflowNetworkNumOfSurfaces
If (MultizoneSurfaceData(i)%VentSurfCtrNum == VentCtrNum_AdjTemp) then
If (.not. Surface(MultizoneSurfaceData(i)%SurfNum)%ExtBoundCond >= 1) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(1))//' = '// &
TRIM(MultizoneSurfaceData(i)%SurfName))
CALL ShowContinueError('..AdjacentTemperature venting control must be defined for an interzone surface.')
ErrorsFound=.true.
End If
End If
If (MultizoneSurfaceData(i)%VentSurfCtrNum == VentCtrNum_AdjEnth) then
If (.not. Surface(MultizoneSurfaceData(i)%SurfNum)%ExtBoundCond >= 1) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '//TRIM(cAlphaFields(1))//' = '// &
TRIM(MultizoneSurfaceData(i)%SurfName))
CALL ShowContinueError('..AdjacentEnthalpy venting control must be defined for an interzone surface.')
ErrorsFound=.true.
End If
End If
end do
! Ensure the number of external node = the number of external surface with HeightOption choice = OpeningHeight
If (SameString(AirflowNetworkSimu%HeightOption,'OpeningHeight') .AND. AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) Then
If (AirflowNetworkNumOfExtSurfaces .NE. AirflowNetworkNumOfExtNode) Then
CALL ShowSevereError(RoutineName// 'When the choice of Height Selection for Local Wind Speed Calculation is OpeningHeight,' &
//' the number of external surfaces defined in '//Trim(CurrentModuleObject)//' objects ')
CALL ShowContinueError('has to be equal to the number of AirflowNetwork:MultiZone:ExternalNode objects.')
CALL ShowContinueError('The entered number of external nodes is '//TRIM(RoundSigDigits(AirflowNetworkNumOfExtNode,0))// &
'. The entered number of external surfaces is '//TRIM(RoundSigDigits(AirflowNetworkNumOfExtSurfaces,0))//'.')
ErrorsFound=.true.
End If
End If
! Read AirflowNetwork simulation detailed openings
CurrentModuleObject='AirflowNetwork:MultiZone:Component:DetailedOpening'
AirflowNetworkNumOfDetOpenings = GetNumObjectsFound(CurrentModuleObject)
If (AirflowNetworkNumOfDetOpenings > 0) then
Allocate(MultizoneCompDetOpeningData(AirflowNetworkNumOfDetOpenings))
Do i=1,AirflowNetworkNumOfDetOpenings
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneCompDetOpeningData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneCompDetOpeningData(i)%Name = Alphas(1) ! Name of large detailed opening component
MultizoneCompDetOpeningData(i)%FlowCoef = Numbers(1) ! Air Mass Flow Coefficient When Window or Door Is Closed
MultizoneCompDetOpeningData(i)%FlowExpo = Numbers(2) ! Air Mass Flow exponent When Window or Door Is Closed
MultizoneCompDetOpeningData(i)%TypeName = Alphas(2) ! Large vertical opening type
if (SameString(Alphas(2),'NonPivoted') .or. SameString(Alphas(2),'1')) then
MultizoneCompDetOpeningData(i)%LVOType = 1 ! Large vertical opening type number
Else If (SameString(Alphas(2),'HorizontallyPivoted') .or. SameString(Alphas(2),'2')) then
MultizoneCompDetOpeningData(i)%LVOType = 2 ! Large vertical opening type number
Else
CALL ShowSevereError(RoutineName//'Invalid '//TRIM(cAlphaFields(2))//' = '//TRIM(Alphas(2))// &
'in '//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('Valid choices are NonPivoted and HorizontallyPivoted.')
ErrorsFound=.true.
End If
MultizoneCompDetOpeningData(i)%LVOValue = Numbers(3) ! Extra crack length for LVO type 1 with multiple openable parts,
! or Height of pivoting axis for LVO type 2
If (MultizoneCompDetOpeningData(i)%LVOValue <0) then
CALL ShowSevereError(RoutineName//'Negative values are not allowed for '//TRIM(cNumericFields(3))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The input value is '//TRIM(RoundSigDigits(Numbers(3),2)))
ErrorsFound=.true.
End If
MultizoneCompDetOpeningData(i)%NumFac = Numbers(4) ! Number of Opening Factor Values
MultizoneCompDetOpeningData(i)%OpenFac1 = Numbers(5) ! Opening factor #1
If (MultizoneCompDetOpeningData(i)%OpenFac1> 0.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(5))//' is reset to 0.0')
CALL ShowContinueError('..Input value was '//TRIM(RoundSigDigits(MultizoneCompDetOpeningData(i)%OpenFac1,2)))
MultizoneCompDetOpeningData(i)%OpenFac1 = 0.0d0
End If
MultizoneCompDetOpeningData(i)%DischCoeff1 = Numbers(6) ! Discharge coefficient for opening factor #1
If (MultizoneCompDetOpeningData(i)%DischCoeff1 .le. 0.0d0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(6))//' is less than or equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
MultizoneCompDetOpeningData(i)%WidthFac1 = Numbers(7) ! Width factor for for Opening factor #1
MultizoneCompDetOpeningData(i)%HeightFac1 = Numbers(8) ! Height factor for opening factor #1
MultizoneCompDetOpeningData(i)%StartHFac1 = Numbers(9) ! Start height factor for opening factor #1
MultizoneCompDetOpeningData(i)%OpenFac2 = Numbers(10) ! Opening factor #2
If (MultizoneCompDetOpeningData(i)%OpenFac2 .NE. 1.0d0 .and. MultizoneCompDetOpeningData(i)%NumFac == 2) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..This object specifies that only 2 opening factors will be used. So, the value '// &
'of '//TRIM(cNumericFields(10))//' is reset to 1.0.')
CALL ShowContinueError('..Input value was '//TRIM(RoundSigDigits(MultizoneCompDetOpeningData(i)%OpenFac2,2)))
MultizoneCompDetOpeningData(i)%OpenFac2 = 1.0d0
End If
MultizoneCompDetOpeningData(i)%DischCoeff2 = Numbers(11) ! Discharge coefficient for opening factor #2
MultizoneCompDetOpeningData(i)%WidthFac2 = Numbers(12) ! Width factor for for Opening factor #2
MultizoneCompDetOpeningData(i)%HeightFac2 = Numbers(13) ! Height factor for opening factor #2
MultizoneCompDetOpeningData(i)%StartHFac2 = Numbers(14) ! Start height factor for opening factor #2
If (MultizoneCompDetOpeningData(i)%DischCoeff2 .le. 0.0d0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(11))//' is less than or equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
MultizoneCompDetOpeningData(i)%OpenFac3 = 0.0d0 ! Opening factor #3
MultizoneCompDetOpeningData(i)%DischCoeff3 = 0.0d0 ! Discharge coefficient for opening factor #3
MultizoneCompDetOpeningData(i)%WidthFac3 = 0.0d0 ! Width factor for for Opening factor #3
MultizoneCompDetOpeningData(i)%HeightFac3 = 0.0d0 ! Height factor for opening factor #3
MultizoneCompDetOpeningData(i)%StartHFac3 = 0.0d0 ! Start height factor for opening factor #3
MultizoneCompDetOpeningData(i)%OpenFac4 = 0.0d0 ! Opening factor #4
MultizoneCompDetOpeningData(i)%DischCoeff4 = 0.0d0 ! Discharge coefficient for opening factor #4
MultizoneCompDetOpeningData(i)%WidthFac4 = 0.0d0 ! Width factor for for Opening factor #4
MultizoneCompDetOpeningData(i)%HeightFac4 = 0.0d0 ! Height factor for opening factor #4
MultizoneCompDetOpeningData(i)%StartHFac4 = 0.0d0 ! Start height factor for opening factor #4
If (MultizoneCompDetOpeningData(i)%NumFac > 2) then
If (NumNumbers .GE. 19) then
MultizoneCompDetOpeningData(i)%OpenFac3 = Numbers(15) ! Opening factor #3
MultizoneCompDetOpeningData(i)%DischCoeff3 = Numbers(16) ! Discharge coefficient for opening factor #3
MultizoneCompDetOpeningData(i)%WidthFac3 = Numbers(17) ! Width factor for for Opening factor #3
MultizoneCompDetOpeningData(i)%HeightFac3 = Numbers(18) ! Height factor for opening factor #3
MultizoneCompDetOpeningData(i)%StartHFac3 = Numbers(19) ! Start height factor for opening factor #3
If (MultizoneCompDetOpeningData(i)%DischCoeff3 .le. 0.0d0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(16))//' is equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%OpenFac3 .NE. 1.0d0 .AND. MultizoneCompDetOpeningData(i)%NumFac == 3) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..This object specifies that only 3 opening factors will be used. So, the value '// &
'of '//TRIM(cNumericFields(15))//' is set to 1.0.')
CALL ShowContinueError('..Input value was '//TRIM(RoundSigDigits(MultizoneCompDetOpeningData(i)%OpenFac3,2)))
MultizoneCompDetOpeningData(i)%OpenFac3 = 1.0d0
End If
Else
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': '// &
TRIM(Alphas(1))// '. The number of opening fields is less than required (21).')
ErrorsFound=.true.
End If
End IF
If (MultizoneCompDetOpeningData(i)%NumFac == 4) then
If (NumNumbers .EQ. 24) then
MultizoneCompDetOpeningData(i)%OpenFac4 = Numbers(20) ! Opening factor #4
MultizoneCompDetOpeningData(i)%DischCoeff4 = Numbers(21) ! Discharge coefficient for opening factor #4
MultizoneCompDetOpeningData(i)%WidthFac4 = Numbers(22) ! Width factor for for Opening factor #4
MultizoneCompDetOpeningData(i)%HeightFac4 = Numbers(23) ! Height factor for opening factor #4
MultizoneCompDetOpeningData(i)%StartHFac4 = Numbers(24) ! Start height factor for opening factor #4
If (MultizoneCompDetOpeningData(i)%DischCoeff4 .le. 0.0d0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(21))//' is equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%OpenFac4 .NE. 1.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..This object specifies that 4 opening factors will be used. So, the value '// &
'of '//TRIM(cNumericFields(20))//' is set to 1.0.')
CALL ShowContinueError('..Input value was '//TRIM(RoundSigDigits(MultizoneCompDetOpeningData(i)%OpenFac3,2)))
MultizoneCompDetOpeningData(i)%OpenFac4 = 1.0d0
End If
Else
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': '// &
TRIM(Alphas(1))//'. The number of opening fields is less than required (26).')
ErrorsFound=.true.
End If
End IF
If (MultizoneCompDetOpeningData(i)%NumFac > 2) then
If (MultizoneCompDetOpeningData(i)%OpenFac2 .GE. MultizoneCompDetOpeningData(i)%OpenFac3) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(10))//' >= the value of '//TRIM(cNumericFields(15)))
ErrorsFound=.true.
end IF
End If
If (MultizoneCompDetOpeningData(i)%NumFac == 4) then
If (MultizoneCompDetOpeningData(i)%OpenFac3 .GE. MultizoneCompDetOpeningData(i)%OpenFac4) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(15))//' >= the value of '//TRIM(cNumericFields(20)))
ErrorsFound=.true.
end IF
End If
! Check values to meet requirements
If (MultizoneCompDetOpeningData(i)%NumFac .GE. 2) Then
! Check width factor
If (MultizoneCompDetOpeningData(i)%WidthFac1 .lt. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(7))//' must be greater than or equal to zero.')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%WidthFac2 .le. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(12))//' must be greater than zero.')
ErrorsFound=.true.
End If
! Check height factor
If (MultizoneCompDetOpeningData(i)%HeightFac1 .lt. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(8))//' must be greater than or equal to zero.')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%HeightFac2 .le. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(13))//' must be greater than zero.')
ErrorsFound=.true.
End If
End If
If (MultizoneCompDetOpeningData(i)%NumFac .GE. 3) Then
! Check width factor
If (MultizoneCompDetOpeningData(i)%WidthFac3 .le. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(17))//' must be greater than zero.')
ErrorsFound=.true.
End If
! Check height factor
If (MultizoneCompDetOpeningData(i)%HeightFac3 .le. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(18))//' must be greater than zero.')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%DischCoeff3 .le. 0.0d0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(16))//' is less than or equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
End If
If (MultizoneCompDetOpeningData(i)%NumFac .GE. 4) Then
! Check width factor
If (MultizoneCompDetOpeningData(i)%WidthFac4 .le. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(22))//' must be greater than zero.')
ErrorsFound=.true.
End If
! Check height factor
If (MultizoneCompDetOpeningData(i)%HeightFac4 .le. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The value of '//TRIM(cNumericFields(23))//' must be greater than zero.')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%DischCoeff4 .le. 0.0d0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(21))//' is less than or equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
End If
! Check sum of Height Factor and the Start Height Factor
If (MultizoneCompDetOpeningData(i)%HeightFac1+MultizoneCompDetOpeningData(i)%StartHFac1 .GT. 1.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The sum of '//TRIM(cNumericFields(8))//' and '//TRIM(cNumericFields(9))//' is greater than 1.0')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%HeightFac2+MultizoneCompDetOpeningData(i)%StartHFac2 .GT. 1.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The sum of '//TRIM(cNumericFields(13))//' and '//TRIM(cNumericFields(14))//' is greater than 1.0')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%HeightFac3+MultizoneCompDetOpeningData(i)%StartHFac3 .GT. 1.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The sum of '//TRIM(cNumericFields(18))//' and '//TRIM(cNumericFields(19))//' is greater than 1.0')
ErrorsFound=.true.
End If
If (MultizoneCompDetOpeningData(i)%HeightFac4+MultizoneCompDetOpeningData(i)%StartHFac4 .GT. 1.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('..The sum of '//TRIM(cNumericFields(23))//' and '//TRIM(cNumericFields(24))//' is greater than 1.0')
ErrorsFound=.true.
End If
End do
End If
! Validate opening component and assign opening dimension
If (AirflowNetworkNumOfDetOpenings > 0) then
Do i=1,AirflowNetworkNumOfDetOpenings
found = .False.
Do j=1,AirflowNetworkNumOfSurfaces
if (MultizoneCompDetOpeningData(i)%Name == MultizoneSurfaceData(j)%OpeningName) then
! MultizoneCompDetOpeningData(i)%Width = Surface(MultizoneSurfaceData(j)%SurfNum)%Width
! MultizoneCompDetOpeningData(i)%Height = Surface(MultizoneSurfaceData(j)%SurfNum)%Height
found = .True.
end if
end do
end do
end if
! Read AirflowNetwork simulation simple openings
CurrentModuleObject='AirflowNetwork:MultiZone:Component:SimpleOpening'
AirflowNetworkNumOfSimOpenings = GetNumObjectsFound(CurrentModuleObject)
If (AirflowNetworkNumOfSimOpenings > 0) then
Allocate(MultizoneCompSimpleOpeningData(AirflowNetworkNumOfSimOpenings))
Do i=1,AirflowNetworkNumOfSimOpenings
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneCompSimpleOpeningData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneCompSimpleOpeningData(i)%Name = Alphas(1) ! Name of large simple opening component
MultizoneCompSimpleOpeningData(i)%FlowCoef = Numbers(1) ! Air Mass Flow Coefficient When Window or Door Is Closed
MultizoneCompSimpleOpeningData(i)%FlowExpo = Numbers(2) ! Air Mass Flow exponent When Window or Door Is Closed
MultizoneCompSimpleOpeningData(i)%MinRhoDiff = Numbers(3) ! Minimum density difference for two-way flow
MultizoneCompSimpleOpeningData(i)%DischCoeff = Numbers(4) ! Discharge coefficient at full opening
End do
End If
! Read AirflowNetwork simulation horizontal openings
CurrentModuleObject='AirflowNetwork:MultiZone:Component:HorizontalOpening'
AirflowNetworkNumOfHorOpenings = GetNumObjectsFound(CurrentModuleObject)
If (AirflowNetworkNumOfHorOpenings > 0) then
Allocate(MultizoneCompHorOpeningData(AirflowNetworkNumOfHorOpenings))
Do i=1,AirflowNetworkNumOfHorOpenings
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneCompHorOpeningData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneCompHorOpeningData(i)%Name = Alphas(1) ! Name of large simple opening component
MultizoneCompHorOpeningData(i)%FlowCoef = Numbers(1) ! Air Mass Flow Coefficient When Window or Door Is Closed
If (Numbers(1) .LE. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(1))//' is less than or equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
MultizoneCompHorOpeningData(i)%FlowExpo = Numbers(2) ! Air Mass Flow exponent When Window or Door Is Closed
If (Numbers(2) .GT. 1.0d0 .OR. Numbers(2) .LT. 0.5d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(2))//' is beyond the boundary. '// &
'A value between 0.5 and 1.0 is required.')
ErrorsFound=.true.
End If
MultizoneCompHorOpeningData(i)%Slope = Numbers(3) ! Sloping plane angle
If (Numbers(3) .GT. 90.0d0 .OR. Numbers(3) .LT. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(3))//' is beyond the boundary. '// &
'A value between 0 and 90.0 is required.')
ErrorsFound=.true.
End If
MultizoneCompHorOpeningData(i)%DischCoeff = Numbers(4) ! Discharge coefficient at full opening
If (Numbers(4) .LE. 0.0d0) Then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The value of '//TRIM(cNumericFields(4))//' is less than or equal to 0. '// &
'A value greater than zero is required.')
ErrorsFound=.true.
End If
End do
End If
! Check status of control level for each surface with an opening
j=0
CurrentModuleObject='AirflowNetwork:MultiZone:Surface'
Do i=1,AirflowNetworkNumOfSurfaces
if (MultizoneSurfaceData(i)%SurfNum == 0) CYCLE
if (AirflowNetworkNumOfDetOpenings > 0) &
j=FindItemInList(MultizoneSurfaceData(i)%OpeningName,MultizoneCompDetOpeningData%Name, &
AirflowNetworkNumOfDetOpenings)
If (j == 0 .and. AirflowNetworkNumOfSimOpenings > 0) &
j=FindItemInList(MultizoneSurfaceData(i)%OpeningName,MultizoneCompSimpleOpeningData%Name, &
AirflowNetworkNumOfSimOpenings)
! Obtain schedule number and check surface shape
If (j > 0) then
If (Surface(MultizoneSurfaceData(i)%SurfNum)%Sides .eq. 3) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(MultizoneSurfaceData(i)%SurfName)//'".')
CALL ShowContinueError('The opening is a Triangular subsurface. A rectangular subsurface should be used.')
End If
If (MultizoneSurfaceData(i)%VentingSchName /= Blank) then
MultizoneSurfaceData(i)%VentingSchNum = GetScheduleIndex(MultizoneSurfaceData(i)%VentingSchName)
If (MultizoneSurfaceData(i)%VentingSchNum == 0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//TRIM(MultizoneSurfaceData(i)%SurfName)// &
'", invalid schedule.')
CALL ShowContinueError('Venting Schedule not found="'//TRIM(MultizoneSurfaceData(i)%VentingSchName)//'".')
ErrorsFound = .true.
end if
Else
MultizoneSurfaceData(i)%VentingSchName = ' '
MultizoneSurfaceData(i)%VentingSchNum = 0
End if
Select Case (MultizoneSurfaceData(i)%VentSurfCtrNum)
Case (VentCtrNum_Temp, VentCtrNum_AdjTemp)
MultizoneSurfaceData(i)%VentSchNum = GetScheduleIndex(MultizoneSurfaceData(i)%VentSchName)
if (MultizoneSurfaceData(i)%VentSchName == Blank) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'No Ventilation Schedule was found, but is required when ventilation control is Temperature.')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
ErrorsFound=.true.
elseif (MultizoneSurfaceData(i)%VentSchNum == 0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'Invalid Ventilation Schedule, required when ventilation control is Temperature.')
CALL ShowContinueError('..Schedule name in error = '//TRIM(MultizoneSurfaceData(i)%VentSchName))
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
ErrorsFound = .true.
end if
if (MultizoneSurfaceData(i)%LowValueTemp < 0.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
' Low Temperature difference value < 0.0d0')
CALL ShowContinueError('..Input value='//TRIM(RoundSigDigits(MultizoneSurfaceData(i)%LowValueTemp,1))// &
', Value will be reset to 0.0.')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
MultizoneSurfaceData(i)%LowValueTemp = 0.0d0
end if
if (MultizoneSurfaceData(i)%LowValueTemp >= 100.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
' Low Temperature difference value >= 100.0d0')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneSurfaceData(i)%LowValueTemp,1))// &
', Value will be reset to 0.0')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
MultizoneZoneData(i)%LowValueTemp = 0.0d0
end if
if (MultizoneSurfaceData(i)%UpValueTemp <= MultizoneSurfaceData(i)%LowValueTemp) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
' Upper Temperature <= Lower Temperature difference value.')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneSurfaceData(i)%UpValueTemp,1))// &
', Value will be reset to 100.0')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
MultizoneSurfaceData(i)%UpValueTemp = 100.0d0
end if
Case (VentCtrNum_Enth, VentCtrNum_AdjEnth)
MultizoneSurfaceData(i)%VentSchNum = GetScheduleIndex(MultizoneSurfaceData(i)%VentSchName)
if (MultizoneSurfaceData(i)%VentSchName == Blank) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'No Ventilation Schedule was found, but is required when ventilation control is Enthalpy.')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
ErrorsFound=.true.
elseif (MultizoneSurfaceData(i)%VentSchNum == 0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'Invalid Ventilation Schedule, required when ventilation control is Enthalpy.')
CALL ShowContinueError('..Schedule name in error = '//TRIM(MultizoneSurfaceData(i)%VentSchName))
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
ErrorsFound = .true.
end if
if (MultizoneSurfaceData(i)%LowValueEnth < 0.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
' Low Enthalpy difference value < 0.0d0')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneSurfaceData(i)%LowValueEnth,1))// &
', Value will be reset to 0.0')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
MultizoneSurfaceData(i)%LowValueEnth = 0.0d0
end if
if (MultizoneSurfaceData(i)%LowValueEnth >= 300000.0d0) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
'Low Enthalpy difference value >= 300000.0')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneSurfaceData(i)%LowValueEnth,1))// &
', Value will be reset to 0.0')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
MultizoneZoneData(i)%LowValueEnth = 0.0d0
end if
if (MultizoneSurfaceData(i)%UpValueEnth <= MultizoneSurfaceData(i)%LowValueEnth) then
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//' object, '// &
' Upper Enthalpy <= Lower Enthalpy difference value.')
CALL ShowContinueError('..Input value = '//TRIM(RoundSigDigits(MultizoneSurfaceData(i)%UpValueEnth,1))// &
', Value will be set to 300000.0')
CALL ShowContinueError('..for Surface = "'//TRIM(MultizoneSurfaceData(i)%SurfName)//'"')
MultizoneSurfaceData(i)%UpValueEnth = 300000.0d0
end if
Case (VentCtrNum_Const)
MultizoneSurfaceData(i)%VentSchNum = 0
MultizoneSurfaceData(i)%VentSchName = ' '
Case (VentCtrNum_ASH55)
MultizoneSurfaceData(i)%VentSchNum = 0
MultizoneSurfaceData(i)%VentSchName = ' '
Case (VentCtrNum_CEN15251)
MultizoneSurfaceData(i)%VentSchNum = 0
MultizoneSurfaceData(i)%VentSchName = ' '
Case (VentCtrNum_Novent)
MultizoneSurfaceData(i)%VentSchNum = 0
MultizoneSurfaceData(i)%VentSchName = ' '
Case (VentCtrNum_ZoneLevel)
MultizoneSurfaceData(i)%VentSchNum = 0
MultizoneSurfaceData(i)%VentSchName = ' '
Case Default
End Select
End If
End Do
! Validate opening component and assign opening dimension
If (AirflowNetworkNumOfSimOpenings > 0) then
Do i=1,AirflowNetworkNumOfSimOpenings
found = .False.
Do j=1,AirflowNetworkNumOfSurfaces
if (MultizoneCompSimpleOpeningData(i)%Name == MultizoneSurfaceData(j)%OpeningName) then
! MultizoneCompSimpleOpeningData(i)%Width = Surface(MultizoneSurfaceData(j)%SurfNum)%Width
! MultizoneCompSimpleOpeningData(i)%Height = Surface(MultizoneSurfaceData(j)%SurfNum)%Height
found = .True.
end if
end do
end do
end if
! *** Read AirflowNetwork simulation reference crack conditions
CurrentModuleObject='AirflowNetwork:MultiZone:ReferenceCrackConditions'
AirflowNetworkNumOfStdCndns = GetNumObjectsFound(CurrentModuleObject)
IF (AirflowNetworkNumOfStdCndns > 0) THEN
Allocate(MultizoneSurfaceStdConditionsCrackData(0:AirflowNetworkNumOfStdCndns))
Do i=1,AirflowNetworkNumOfStdCndns
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneSurfaceStdConditionsCrackData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
MultizoneSurfaceStdConditionsCrackData(i)%Name = Alphas(1)
MultizoneSurfaceStdConditionsCrackData(i)%StandardT = Numbers(1) ! Reference temperature for crack data
MultizoneSurfaceStdConditionsCrackData(i)%StandardP = Numbers(2) ! Reference barometric pressure for crack data
IF (ABS((MultizoneSurfaceStdConditionsCrackData(i)%StandardP-StdBaroPress)/StdBaroPress) > 0.1d0) THEN ! 10% off
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//': Pressure = '// &
TRIM(RoundSigDigits(MultizoneSurfaceStdConditionsCrackData(i)%StandardP,0))// &
' differs by more than 10% from Standard Barometric Pressure = '// &
TRIM(RoundSigDigits(StdBaroPress,0))//'.')
CALL ShowContinueError('...occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
ENDIF
If (MultizoneSurfaceStdConditionsCrackData(i)%StandardP <= 31000.0d0) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': '//TRIM(Alphas(1))// &
'. '//TRIM(cNumericFields(2))//' must be greater than 31000 Pa.')
ErrorsFound=.true.
end IF
MultizoneSurfaceStdConditionsCrackData(i)%StandardW = Numbers(3) ! Reference humidity ratio for crack data
ENDDO
ELSE
AirflowNetworkNumOfStdCndns=0
Allocate(MultizoneSurfaceStdConditionsCrackData(0:1))
MultizoneSurfaceStdConditionsCrackData(0)%Name = '*'
MultizoneSurfaceStdConditionsCrackData(0)%StandardT = 20.d0
MultizoneSurfaceStdConditionsCrackData(0)%StandardP = 101325.d0
MultizoneSurfaceStdConditionsCrackData(0)%StandardW = 0.0d0
ENDIF
! *** Read AirflowNetwork simulation surface crack component
CurrentModuleObject='AirflowNetwork:MultiZone:Surface:Crack'
AirflowNetworkNumOfSurCracks = GetNumObjectsFound(CurrentModuleObject)
If (AirflowNetworkNumOfSurCracks > 0) then
Allocate(MultizoneSurfaceCrackData(AirflowNetworkNumOfSurCracks))
Do i=1,AirflowNetworkNumOfSurCracks
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneSurfaceCrackData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneSurfaceCrackData(i)%Name = Alphas(1) ! Name of surface crack component
MultizoneSurfaceCrackData(i)%FlowCoef = Numbers(1) ! Air Mass Flow Coefficient
MultizoneSurfaceCrackData(i)%FlowExpo = Numbers(2) ! Air Mass Flow exponent
IF (lAlphaBlanks(2)) THEN
IF (AirflowNetworkNumOfStdCndns == 1) THEN
MultiZoneSurfaceCrackData(i)%StandardT=MultizoneSurfaceStdConditionsCrackData(1)%StandardT
MultiZoneSurfaceCrackData(i)%StandardP=MultizoneSurfaceStdConditionsCrackData(1)%StandardP
MultiZoneSurfaceCrackData(i)%StandardW=MultizoneSurfaceStdConditionsCrackData(1)%StandardW
ELSE
MultiZoneSurfaceCrackData(i)%StandardT=MultizoneSurfaceStdConditionsCrackData(0)%StandardT
MultiZoneSurfaceCrackData(i)%StandardP=MultizoneSurfaceStdConditionsCrackData(0)%StandardP
MultiZoneSurfaceCrackData(i)%StandardW=MultizoneSurfaceStdConditionsCrackData(0)%StandardW
ENDIF
ELSE
j=FindItemInList(Alphas(2),MultizoneSurfaceStdConditionsCrackData(1:AirflowNetworkNumOfStdCndns)%Name, &
AirflowNetworkNumOfStdCndns)
IF (j == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1))// &
'. Specified '//TRIM(cAlphaFields(2))//' = '//TRIM(Alphas(2))//' not found.')
ErrorsFound=.true.
ELSE
MultiZoneSurfaceCrackData(i)%StandardT=MultizoneSurfaceStdConditionsCrackData(j)%StandardT
MultiZoneSurfaceCrackData(i)%StandardP=MultizoneSurfaceStdConditionsCrackData(j)%StandardP
MultiZoneSurfaceCrackData(i)%StandardW=MultizoneSurfaceStdConditionsCrackData(j)%StandardW
ENDIF
ENDIF
End do
End If
! *** Read AirflowNetwork simulation surface effective leakage area component
CurrentModuleObject='AirflowNetwork:MultiZone:Surface:EffectiveLeakageArea'
AirflowNetworkNumOfSurELA = GetNumObjectsFound(CurrentModuleObject)
If (AirflowNetworkNumOfSurELA > 0) then
Allocate(MultizoneSurfaceELAData(AirflowNetworkNumOfSurELA))
Do i=1,AirflowNetworkNumOfSurELA
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneSurfaceELAData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneSurfaceELAData(i)%Name = Alphas(1) ! Name of surface effective leakage area component
MultizoneSurfaceELAData(i)%ELA = Numbers(1) ! Effective leakage area
MultizoneSurfaceELAData(i)%DischCoeff = Numbers(2) ! Discharge coefficient
MultizoneSurfaceELAData(i)%RefDeltaP = Numbers(3) ! Reference pressure difference
MultizoneSurfaceELAData(i)%FlowExpo = Numbers(4) ! Air Mass Flow exponent
MultizoneSurfaceELAData(i)%TestDeltaP = 0.0d0 ! Testing pressure difference
MultizoneSurfaceELAData(i)%TestDisCoef = 0.0d0 ! Testing Discharge coefficient
End do
End If
! *** Read AirflowNetwork simulation zone exhaust fan component
CurrentModuleObject='AirflowNetwork:MultiZone:Component:ZoneExhaustFan'
AirflowNetworkNumOfExhFan = GetNumObjectsFound(CurrentModuleObject)
NumOfExhaustFans = GetNumObjectsFound('Fan:ZoneExhaust')
If (AirflowNetworkNumOfExhFan > 0) then
Allocate(MultizoneCompExhaustFanData(AirflowNetworkNumOfExhFan))
Do i=1,AirflowNetworkNumOfExhFan
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneCompExhaustFanData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
MultizoneCompExhaustFanData(i)%Name = Alphas(1) ! Name of zone exhaust fan component
MultizoneCompExhaustFanData(i)%FlowCoef = Numbers(1) ! flow coefficient
MultizoneCompExhaustFanData(i)%FlowExpo = Numbers(2) ! Flow exponent
FanErrorFound=.false.
CALL GetFanIndex(MultizoneCompExhaustFanData(i)%Name,FanIndex,FanErrorFound)
If (FanErrorFound) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1))// &
' is not found in Fan:ZoneExhaust objects.')
ErrorsFound=.true.
ENDIF
CALL GetFanVolFlow(FanIndex,MultizoneCompExhaustFanData(i)%FlowRate)
MultizoneCompExhaustFanData(i)%FlowRate = StdRhoAir*MultizoneCompExhaustFanData(i)%FlowRate
MultizoneCompExhaustFanData(i)%InletNode = GetFanInletNode('Fan:ZoneExhaust',Alphas(1),ErrorsFound)
MultizoneCompExhaustFanData(i)%OutletNode = GetFanOutletNode('Fan:ZoneExhaust',Alphas(1),ErrorsFound)
CALL GetFanType(Alphas(1),FanType_Num,FanErrorFound)
IF (FanType_Num .NE. FanType_ZoneExhaust) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1))// &
'. The specified '//TRIM(cAlphaFields(1))//' is not found as a valid Fan:ZoneExhaust object.')
ErrorsFound=.true.
ENDIF
IF (lAlphaBlanks(2)) THEN
IF (AirflowNetworkNumOfStdCndns == 1) THEN
MultizoneCompExhaustFanData(i)%StandardT=MultizoneSurfaceStdConditionsCrackData(1)%StandardT
MultizoneCompExhaustFanData(i)%StandardP=MultizoneSurfaceStdConditionsCrackData(1)%StandardP
MultizoneCompExhaustFanData(i)%StandardW=MultizoneSurfaceStdConditionsCrackData(1)%StandardW
ELSE
MultizoneCompExhaustFanData(i)%StandardT=MultizoneSurfaceStdConditionsCrackData(0)%StandardT
MultizoneCompExhaustFanData(i)%StandardP=MultizoneSurfaceStdConditionsCrackData(0)%StandardP
MultizoneCompExhaustFanData(i)%StandardW=MultizoneSurfaceStdConditionsCrackData(0)%StandardW
ENDIF
ELSE
j=FindItemInList(Alphas(2),MultizoneSurfaceStdConditionsCrackData(1:AirflowNetworkNumOfStdCndns)%Name, &
AirflowNetworkNumOfStdCndns)
IF (j == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1))// &
'. Specified '//TRIM(cAlphaFields(2))//' = '//TRIM(Alphas(2))//' not found.')
ErrorsFound=.true.
ELSE
MultizoneCompExhaustFanData(i)%StandardT=MultizoneSurfaceStdConditionsCrackData(j)%StandardT
MultizoneCompExhaustFanData(i)%StandardP=MultizoneSurfaceStdConditionsCrackData(j)%StandardP
MultizoneCompExhaustFanData(i)%StandardW=MultizoneSurfaceStdConditionsCrackData(j)%StandardW
ENDIF
ENDIF
end do
End If
! *** Read AirflowNetwork CP Array
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then ! Surface-Average does not need inputs of external nodes
CurrentModuleObject='AirflowNetwork:MultiZone:WindPressureCoefficientArray'
AirflowNetworkNumOfCPArray = GetNumObjectsFound(CurrentModuleObject)
if (AirflowNetworkNumOfCPArray .NE. 1) then
CALL ShowSevereError(RoutineName//'Currently only one ("1") '//TRIM(CurrentModuleObject)// &
' object per simulation allowed when using the AirflowNetwork model.')
ErrorsFound=.true.
end if
If (AirflowNetworkNumOfCPArray > 0 .AND. AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
Allocate(MultizoneCPArrayData(AirflowNetworkNumOfCPArray))
Do i=1,AirflowNetworkNumOfCPArray
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
MultizoneCPArrayData(i)%Name = Alphas(1) ! Name of CP array
MultizoneCPArrayData(i)%NumWindDir = NumNumbers
Allocate(MultizoneCPArrayData(i)%WindDir(NumNumbers))
DO j=1, NumNumbers ! Wind direction
MultizoneCPArrayData(i)%WindDir(j) = Numbers(j)
If (j > 1) THEN
If (MultizoneCPArrayData(i)%WindDir(j-1) .GE. MultizoneCPArrayData(i)%WindDir(j)) Then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object ')
CALL ShowContinueError('has either the same values for two consecutive wind directions, or a lower wind direction'// &
' value after a higher wind direction value.')
CALL ShowContinueError('Wind direction values must be entered in ascending order.')
CALL ShowContinueError(TRIM(cNumericFields(j))//' = ' &
//TRIM(RoundSigDigits(MultizoneCPArrayData(i)%WindDir(j-1),2))//' '//TRIM(cNumericFields(j+1))//' = ' &
//TRIM(RoundSigDigits(MultizoneCPArrayData(i)%WindDir(j),2)))
ErrorsFound=.true.
End If
End If
end do
End Do
Else
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then ! Wind coefficient == Surface-Average does not need inputs of CP Array
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object is required.')
CALL ShowContinueError('..but not found with Wind Pressure Coefficient Type = INPUT')
ErrorsFound=.true.
end if
End If
End If
! Get the number of wind directions
If (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
AirflowNetworkSimu%NWind = NumNumbers
else
! AirflowNetworkSimu%NWind = 4
end if
! Read AirflowNetwork CP Value
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then ! Surface-Average does not need inputs of external nodes
CurrentModuleObject='AirflowNetwork:MultiZone:WindPressureCoefficientValues'
AirflowNetworkNumOfCPValue = GetNumObjectsFound(CurrentModuleObject)
If (AirflowNetworkNumOfCPValue > 0 .AND. AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
Allocate(MultizoneCPValueData(AirflowNetworkNumOfCPValue))
Do i=1,AirflowNetworkNumOfCPValue
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),MultizoneCPValueData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(2)='xxxxx'
ENDIF
MultizoneCPValueData(i)%Name = Alphas(1) ! Name of CP value
MultizoneCPValueData(i)%CPArrayName = Alphas(2) ! CP array Name
! Ensure the CP array name should be the same as the name of AirflowNetwork:MultiZone:WindPressureCoefficientArray
if (.NOT. SameString(Alphas(2),MultizoneCPArrayData(1)%Name)) then
CALL ShowSevereError(RoutineName//'Invalid '//TRIM(cAlphaFields(2))//' = '//TRIM(Alphas(2))// &
' in '//TRIM(CurrentModuleObject)//' = '//TRIM(Alphas(1)))
CALL ShowContinueError('The valid name is '//Trim(MultizoneCPArrayData(1)%Name))
ErrorsFound=.true.
End If
Allocate(MultizoneCPValueData(i)%CPValue(NumNumbers))
If (NumNumbers .LT. AirflowNetworkSimu%NWind) Then
CALL ShowSevereError(RoutineName//'The number of WPC Values ('// &
TRIM(RoundSigDigits(NumNumbers,0))//') in the '//TRIM(CurrentModuleObject)//' object ')
CALL ShowContinueError(TRIM(Alphas(1))//' with '//TRIM(cAlphaFields(2))//' = '//TRIM(Alphas(2))// &
' is less than the number of Wind Directions ('// &
TRIM(RoundSigDigits(MultizoneCPArrayData(1)%NumWindDir,0))//') defined in the ')
CALL ShowContinueError(TRIM(CurrentModuleObject)//' object.')
CALL ShowFatalError(RoutineName//'Errors found getting inputs. Previous error(s) cause program termination.')
End If
DO j=1, NumNumbers ! CP Value
MultizoneCPValueData(i)%CPValue(j) = Numbers(j)
end do
End Do
Else
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then ! Wind coefficient == Surface-Average does not need inputs of CP Array
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object is required and not found' &
// ' with Wind Pressure Coefficient Type = INPUT')
ErrorsFound=.true.
end if
End If
End If
! Calculate CP values
If (SameString(AirflowNetworkSimu%WPCCntr,'SurfaceAverageCalculation')) then
Call CalcWindPressureCoeffs
! Ensure automatic generation is OK
n = 0
Do j=1,5
found = .FALSE.
Do i=1,AirflowNetworkNumOfExtNode
If (MultizoneExternalNodeData(i)%CPVNum == j) Then
found = .TRUE.
Exit
End If
End Do
If (found) n = n+1
If (j == 5 .AND. (.NOT. found)) Then
found = .TRUE.
If (DisplayExtraWarnings) Then
CALL ShowWarningError(RoutineName//'SurfaceAverageCalculation is entered for field = Wind Pressure Coefficient ' &
//'Type, but no roof surface is defined using an AirflowNetwork:MultiZone:Surface object.')
CALL ShowContinueError('Reconsider if this is your modeling intent. Simulation continues.')
End If
End If
End Do
If (n .LT. 5 .AND. DisplayExtraWarnings) Then
CALL ShowWarningError(RoutineName//'SurfaceAverageCalculation is entered for field = Wind Pressure Coefficient Type.')
CALL ShowContinueError('The AirflowNetwork model provides wind pressure coefficients for 4 vertical exterior ' &
//'orientations and 1 horizontal roof.')
CALL ShowContinueError('There are only '//TRIM(RoundSigDigits(n,0))//' exterior surface orientations defined' &
//' in this input file using AirflowNetwork:MultiZone:Surface objects.')
CALL ShowContinueError('Reconsider if this is your modeling intent. Simulation continues.')
End If
End If
! Assign external node height
If (SameString(AirflowNetworkSimu%WPCCntr,'SurfaceAverageCalculation') .OR. &
SameString(AirflowNetworkSimu%HeightOption,'OpeningHeight')) then
Do i=1,AirflowNetworkNumOfExtNode
Do j=1,AirflowNetworkNumOfSurfaces
If (Surface(MultizoneSurfaceData(j)%SurfNum)%ExtBoundCond == ExternalEnvironment) Then
If (SameString(MultizoneSurfaceData(j)%ExternalNodeName,MultizoneExternalNodeData(i)%Name)) Then
MultizoneExternalNodeData(i)%height = Surface(MultizoneSurfaceData(j)%SurfNum)%Centroid%Z
Exit
End If
End If
End DO
End Do
End If
IF (ErrorsFound) CALL ShowFatalError(RoutineName//'Errors found getting inputs. Previous error(s) cause program termination.')
! Write wind pressure coefficients in the EIO file
WRITE(OutputFileInits,fmta) '! <AirflowNetwork Model:Wind Direction>, Wind Direction #1 to n (degree)'
WRITE(OutputFileInits,fmta,advance='No') 'AirflowNetwork Model:Wind Direction, '
DO I=1,AirflowNetworkSimu%NWind-1
StringOut=RoundSigDigits(MultizoneCPArrayData(1)%WindDir(I),1)
WRITE(OutputFileInits,fmta,advance='No') TRIM(StringOut)//','
END DO
StringOut=RoundSigDigits(MultizoneCPArrayData(1)%WindDir(AirflowNetworkSimu%NWind),1)
WRITE(OutputFileInits,fmta) TRIM(StringOut)
WRITE(OutputFileInits,fmta,advance='No') '! <AirflowNetwork Model:Wind Pressure Coefficients>, Name, '
WRITE(OutputFileInits,fmta) 'Wind Pressure Coefficients #1 to n (dimensionless)'
Do I=1,AirflowNetworkNumOfCPValue
WRITE(OutputFileInits,fmta,advance='No') 'AirflowNetwork Model:Wind Pressure Coefficients, '
WRITE(OutputFileInits,fmta,advance='No') TRIM(MultizoneCpValueData(i)%Name)//', '
DO J=1,AirflowNetworkSimu%NWind-1
StringOut=RoundSigDigits(MultizoneCpValueData(i)%CPValue(J),2)
WRITE(OutputFileInits,fmta,advance='No') TRIM(StringOut)//','
END DO
StringOut=RoundSigDigits(MultizoneCpValueData(i)%CPValue(AirflowNetworkSimu%NWind),2)
WRITE(OutputFileInits,fmta) TRIM(StringOut)
End Do
! If no zone object, exit
If (AirflowNetworkNumOfZones .eq. 0) Then
CALL ShowFatalError(RoutineName//'Errors found getting inputs. Previous error(s) cause program termination.')
End If
! If zone node number =0, exit.
Do j=1,AirflowNetworkNumOfSurfaces
If (MultizoneSurfaceData(j)%NodeNums(1) .EQ. 0 .AND. ErrorsFound) Then
CALL ShowFatalError(RoutineName//'Errors found getting inputs. Previous error(s) cause program termination.')
End If
If (MultizoneSurfaceData(j)%NodeNums(2) .EQ. 0 .AND. ErrorsFound) Then
CALL ShowFatalError(RoutineName//'Errors found getting inputs. Previous error(s) cause program termination.')
End If
End Do
! Ensure at least two surfaces are exposed to a zone
ALLOCATE(ZoneCheck(AirflowNetworkNumOfZones))
ALLOCATE(ZoneBCCheck(AirflowNetworkNumOfZones))
ZoneCheck = 0
ZoneBCCheck = 0
CurrentModuleObject='AirflowNetwork:MultiZone:Surface'
Do j=1,AirflowNetworkNumOfSurfaces
If (MultizoneSurfaceData(j)%NodeNums(1) .LE. AirflowNetworkNumOfZones) then
ZoneCheck(MultizoneSurfaceData(j)%NodeNums(1)) = ZoneCheck(MultizoneSurfaceData(j)%NodeNums(1))+1
ZoneBCCheck(MultizoneSurfaceData(j)%NodeNums(1)) = MultizoneSurfaceData(j)%NodeNums(2)
End If
If (MultizoneSurfaceData(j)%NodeNums(2) .LE. AirflowNetworkNumOfZones) then
ZoneCheck(MultizoneSurfaceData(j)%NodeNums(2)) = ZoneCheck(MultizoneSurfaceData(j)%NodeNums(2))+1
ZoneBCCheck(MultizoneSurfaceData(j)%NodeNums(2)) = MultizoneSurfaceData(j)%NodeNums(1)
End If
End Do
Do i=1,AirflowNetworkNumOfZones
If (ZoneCheck(i) .EQ. 0) then
CALL ShowSevereError(RoutineName//'AirflowNetwork:Multizone:Zone = '//TRIM(MultizoneZoneData(i)%ZoneName))
CALL ShowContinueError(' does not have any surfaces defined in '//TRIM(CurrentModuleObject))
CALL ShowContinueError('Each zone should have at least two surfaces defined in '//TRIM(CurrentModuleObject))
ErrorsFound=.true.
End If
If (ZoneCheck(i) .EQ. 1) then
CALL ShowSevereError(RoutineName//'AirflowNetwork:Multizone:Zone = '//TRIM(MultizoneZoneData(i)%ZoneName))
CALL ShowContinueError(' has only one surface defined in '//TRIM(CurrentModuleObject))
CALL ShowContinueError(' Each zone should have at least two surfaces defined in '//TRIM(CurrentModuleObject))
ErrorsFound=.true.
End If
If (ZoneCheck(i) > 1) then
SurfaceFound = .FALSE.
Do j=1,AirflowNetworkNumOfSurfaces
If (MultizoneSurfaceData(j)%NodeNums(1) == i) then
If (ZoneBCCheck(i) .NE. MultizoneSurfaceData(j)%NodeNums(2)) then
SurfaceFound = .TRUE.
Exit
End If
End If
If (MultizoneSurfaceData(j)%NodeNums(2) == i) then
If (ZoneBCCheck(i) .NE. MultizoneSurfaceData(j)%NodeNums(1)) then
SurfaceFound = .TRUE.
Exit
End If
End If
End Do
If (.NOT. SurfaceFound) then
CALL ShowWarningError(RoutineName//'AirflowNetwork:Multizone:Zone = '//TRIM(MultizoneZoneData(i)%ZoneName))
CALL ShowContinueError('has more than one surface defined in '//TRIM(CurrentModuleObject)//', but has the same ' &
//'boundary conditions')
CALL ShowContinueError('Please check inputs of '//TRIM(CurrentModuleObject))
End If
End If
End Do
DEALLOCATE(ZoneCheck)
DEALLOCATE(ZoneBCCheck)
! Validate CP Value number
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then ! Surface-Average does not need inputs of external nodes
! Ensure no duplicated external names in CP Value
CurrentModuleObject='AirflowNetwork:MultiZone:WindPressureCoefficientValues'
Do j=1,AirflowNetworkNumOfExtNode
found = .False.
Do i=1,AirflowNetworkNumOfCPValue
if (SameString(MultizoneExternalNodeData(j)%WPCName,MultizoneCPValueData(i)%Name)) then
MultizoneExternalNodeData(j)%CPVNum = i
Exit
end if
end do
If (MultizoneExternalNodeData(j)%CPVNum == 0) then
CALL ShowSevereError(RoutineName//'AirflowNetwork:MultiZone:ExternalNode: Wind Pressure Coefficient ' &
//'Values Object Name is not found in ' //Trim(MultizoneExternalNodeData(j)%Name))
CALL ShowContinueError('Please ensure there is a WindPressureCoefficientValues name defined as '// &
TRIM(MultizoneExternalNodeData(j)%WPCName) //' in '//TRIM(CurrentModuleObject))
ErrorsFound=.true.
End If
End do
! Ensure different CPVNum is used to avoid a single side boundary condition
found = .False.
Do j=2,AirflowNetworkNumOfExtNode
If (MultizoneExternalNodeData(j-1)%CPVNum .NE. MultizoneExternalNodeData(j)%CPVNum) Then
found = .True.
Exit
End If
End do
If (.NOT. found) then
CALL ShowSevereError('The same Wind Pressure Coefficient Values Object name is used in all ' &
//'AirflowNetwork:MultiZone:ExternalNode objects.')
CALL ShowContinueError('Please input at least two different Wind Pressure Coefficient Values Object names'&
//' to avoid single side boundary condition.')
ErrorsFound=.true.
End If
End If
! Read AirflowNetwork Distribution system node
CurrentModuleObject='AirflowNetwork:Distribution:Node'
DisSysNumOfNodes = GetNumObjectsFound(CurrentModuleObject)
if (DisSysNumOfNodes > 0) then
Allocate(DisSysNodeData(DisSysNumOfNodes))
Do i=1,DisSysNumOfNodes
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysNodeData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysNodeData(i)%Name = Alphas(1) ! Name of node
DisSysNodeData(i)%EPlusName = Alphas(2) ! Name of associated EnergyPlus node
DisSysNodeData(i)%EPlusType = Alphas(3) ! Name of associated EnergyPlus type
DisSysNodeData(i)%Height = Numbers(1) ! Nodal height
DisSysNodeData(i)%EPlusNodeNum = 0 ! EPlus node number
! verify EnergyPlus object type
if (SameString(Alphas(3),'AirLoopHVAC:ZoneMixer') .or. SameString(Alphas(3),'AirLoopHVAC:ZoneSplitter') .or. &
SameString(Alphas(3),'AirLoopHVAC:OutdoorAirSystem') .or. SameString(Alphas(3),'OAMixerOutdoorAirStreamNode') .or. &
SameString(Alphas(3),'OutdoorAir:NodeList') .or. SameString(Alphas(3),'OutdoorAir:Node') .or. &
SameString(Alphas(3),'Other') .or. lAlphaBlanks(3)) then
cycle
else
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(Alphas(1))//'" invalid '// &
trim(cAlphaFields(3))//'="'//trim(Alphas(3))//'" illegal key.')
CALL ShowContinueError('Valid keys are: AirLoopHVAC:ZoneMixer, AirLoopHVAC:ZoneSplitter, AirLoopHVAC:OutdoorAirSystem, '// &
'OAMixerOutdoorAirStreamNode, OutdoorAir:NodeList, OutdoorAir:Node or Other.')
ErrorsFound=.true.
endif
end do
Else
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone+1) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object is required but not found.')
ErrorsFound=.true.
End If
End If
! Read AirflowNetwork Distribution system component: duct leakage
CurrentModuleObject='AirflowNetwork:Distribution:Component:Leak'
DisSysNumOfLeaks = GetNumObjectsFound(CurrentModuleObject)
If (DisSysNumOfLeaks > 0) then
Allocate(DisSysCompLeakData(DisSysNumOfLeaks))
Do i=1,DisSysNumOfLeaks
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysCompLeakData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysCompLeakData(i)%Name = Alphas(1) ! Name of duct leak component
DisSysCompLeakData(i)%FlowCoef = Numbers(1) ! Air Mass Flow Coefficient
DisSysCompLeakData(i)%FlowExpo = Numbers(2) ! Air Mass Flow exponent
end do
Else
! if (AirflowNetworkSimu%DistControl == "DISTRIBUTIONSYSTEM") &
! CALL ShowMessage('GetAirflowNetworkInput: AirflowNetwork:Distribution:Component Leak: This object is not used')
End If
! Read AirflowNetwork Distribution system component: duct effective leakage ratio
CurrentModuleObject='AirflowNetwork:Distribution:Component:LeakageRatio'
DisSysNumOfELRs = GetNumObjectsFound(CurrentModuleObject)
If (DisSysNumOfELRs > 0) then
Allocate(DisSysCompELRData(DisSysNumOfELRs))
Do i=1,DisSysNumOfELRs
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysCompELRData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysCompELRData(i)%Name = Alphas(1) ! Name of duct effective leakage ratio component
DisSysCompELRData(i)%ELR = Numbers(1) ! Value of effective leakage ratio
DisSysCompELRData(i)%FlowRate = Numbers(2) ! Maximum airflow rate
DisSysCompELRData(i)%RefPres = Numbers(3) ! Reference pressure difference
DisSysCompELRData(i)%FlowExpo = Numbers(4) ! Air Mass Flow exponent
DisSysCompELRData(i)%FlowRate = Numbers(2)*StdRhoAir
end do
Else
! if (AirflowNetworkSimu%DistControl == "DISTRIBUTIONSYSTEM") &
! CALL ShowMessage('GetAirflowNetworkInput: AirflowNetwork:Distribution:Component Leakage Ratio: This object is not used')
End If
! Read AirflowNetwork Distribution system component: duct
CurrentModuleObject='AirflowNetwork:Distribution:Component:Duct'
DisSysNumOfDucts = GetNumObjectsFound(CurrentModuleObject)
If (DisSysNumOfDucts > 0) then
Allocate(DisSysCompDuctData(DisSysNumOfDucts))
Do i=1,DisSysNumOfDucts
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysCompDuctData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysCompDuctData(i)%Name = Alphas(1) ! Name of duct effective leakage ratio component
DisSysCompDuctData(i)%L = Numbers(1) ! Duct length [m]
DisSysCompDuctData(i)%D = Numbers(2) ! Hydrolic diameter [m]
DisSysCompDuctData(i)%A = Numbers(3) ! Cross section area [m2]
DisSysCompDuctData(i)%Rough = Numbers(4) ! Surface roughness [m]
DisSysCompDuctData(i)%TurDynCoef = Numbers(5) ! Turbulent dynamic loss coefficient
DisSysCompDuctData(i)%UThermal = Numbers(6) ! Overall heat transmittance [W/m2.K]
DisSysCompDuctData(i)%UMoisture = Numbers(7) ! Overall moisture transmittance [kg/m2]
DisSysCompDuctData(i)%MThermal = 0.0d0 ! Thermal capacity [J/K]
DisSysCompDuctData(i)%MMoisture = 0.0d0 ! Mositure capacity [kg]
DisSysCompDuctData(i)%LamDynCoef = 64.0d0 ! Laminar dynamic loss coefficient
DisSysCompDuctData(i)%LamFriCoef = Numbers(5) ! Laminar friction loss coefficient
DisSysCompDuctData(i)%InitLamCoef = 128.0d0 ! Coefficient of linear initialization
DisSysCompDuctData(i)%RelRough = Numbers(4)/Numbers(2) ! e/D: relative roughness
DisSysCompDuctData(i)%RelL = Numbers(1)/Numbers(2) ! L/D: relative length
DisSysCompDuctData(i)%A1 = 1.14d0 - 0.868589d0*LOG(DisSysCompDuctData(i)%RelRough) ! 1.14 - 0.868589*ln(e/D)
DisSysCompDuctData(i)%g = DisSysCompDuctData(i)%A1 ! 1/sqrt(Darcy friction factor)
end do
Else
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone+1) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object is required but not found.')
ErrorsFound=.true.
End If
End If
! Read AirflowNetwork Distribution system component: Damper
! CurrentModuleObject='AIRFLOWNETWORK:DISTRIBUTION:COMPONENT DAMPER'
! Deleted on Aug. 13, 2008
! Read AirflowNetwork Distribution system component: constant volume fan
CurrentModuleObject='AirflowNetwork:Distribution:Component:Fan'
DisSysNumOfCVFs = GetNumObjectsFound(CurrentModuleObject)
If (DisSysNumOfCVFs > 0) then
Allocate(DisSysCompCVFData(DisSysNumOfCVFs))
Do i=1,DisSysNumOfCVFs
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
DisSysCompCVFData(i)%Name = Alphas(1) ! Name of duct effective leakage ratio component
DisSysCompCVFData(i)%Ctrl = 1.0d0 ! Control ratio
FanErrorFound=.false.
CALL GetFanIndex(DisSysCompCVFData(i)%Name,FanIndex,FanErrorFound)
DisSysCompCVFData(i)%FanIndex = FanIndex
If (FanErrorFound) THEN
CALL ShowSevereError('...occurs in '//TRIM(CurrentModuleObject)//' = '// &
TRIM(DisSysCompCVFData(i)%Name))
ErrorsFound=.true.
ENDIF
CALL GetFanVolFlow(FanIndex,DisSysCompCVFData(i)%FlowRate)
DisSysCompCVFData(i)%FlowRate = StdRhoAir*DisSysCompCVFData(i)%FlowRate
CALL GetFanType(Alphas(1),FanType_Num,FanErrorFound)
DisSysCompCVFData(i)%FanTypeNum = FanType_Num
SupplyFanType = FanType_Num
If (.NOT. (FanType_Num .EQ. FanType_SimpleConstVolume .or. FanType_Num .EQ. FanType_SimpleOnOff .or. &
FanType_Num .EQ. FanType_SimpleVAV)) then
CALL ShowSevereError(RoutineName//'The '//TRIM(cAlphaFields(2))//' in '//TRIM(CurrentModuleObject)// &
' = '//TRIM(Alphas(1))//' is not a valid fan type.')
CALL ShowContinueError('Valid fan types are Fan:ConstantVolume or Fan:OnOff')
ErrorsFound=.true.
Else
If (SameString(Alphas(2),'Fan:ConstantVolume') .AND. FanType_Num .EQ. FanType_SimpleOnOff) then
CALL ShowSevereError('The '//TRIM(cAlphaFields(2))//' defined in '//TRIM(CurrentModuleObject)// &
' is '//TRIM(Alphas(2)))
CALL ShowContinueError('The '//TRIM(cAlphaFields(2))//' defined in an AirLoopHVAC is Fan:OnOff')
ErrorsFound=.true.
End If
If (SameString(Alphas(2),'Fan:OnOff') .AND. FanType_Num .EQ. FanType_SimpleConstVolume) then
CALL ShowSevereError('The '//TRIM(cAlphaFields(2))//' defined in '//TRIM(CurrentModuleObject)// &
' is '//TRIM(Alphas(2)))
CALL ShowContinueError('The '//TRIM(cAlphaFields(2))//' defined in an AirLoopHVAC is Fan:ConstantVolume')
ErrorsFound=.true.
End If
End If
If (FanType_Num .EQ. FanType_SimpleConstVolume) then
SupplyFanInletNode = GetFanInletNode('Fan:ConstantVolume',Alphas(1),ErrorsFound)
DisSysCompCVFData(i)%InletNode = SupplyFanInletNode
DisSysCompCVFData(i)%OutletNode = GetFanOutletNode('Fan:ConstantVolume',Alphas(1),ErrorsFound)
SupplyFanOutletNode = DisSysCompCVFData(i)%OutletNode
End If
If (FanType_Num .EQ. FanType_SimpleOnOff) then
SupplyFanInletNode = GetFanInletNode('Fan:OnOff',Alphas(1),ErrorsFound)
DisSysCompCVFData(i)%InletNode = SupplyFanInletNode
DisSysCompCVFData(i)%OutletNode = GetFanOutletNode('Fan:OnOff',Alphas(1),ErrorsFound)
SupplyFanOutletNode = DisSysCompCVFData(i)%OutletNode
End If
If (FanType_Num .EQ. FanType_SimpleVAV) then
SupplyFanInletNode = GetFanInletNode('Fan:VariableVolume',Alphas(1),ErrorsFound)
DisSysCompCVFData(i)%InletNode = SupplyFanInletNode
DisSysCompCVFData(i)%OutletNode = GetFanOutletNode('Fan:VariableVolume',Alphas(1),ErrorsFound)
SupplyFanOutletNode = DisSysCompCVFData(i)%OutletNode
VAVSystem = .TRUE.
End If
end do
Else
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone+1) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object is required but not found.')
ErrorsFound=.true.
End If
End If
! Check AirTerminal:SingleDuct:Uncontrolled. This object is not allowed
If (VAVSystem) Then
i = GetNumObjectsFound('AirTerminal:SingleDuct:Uncontrolled')
If (i .GT. 0) Then
CALL ShowSevereError(RoutineName//'Invalid terminal type for a VAV system = AirTerminal:SingleDuct:Uncontrolled')
CALL ShowContinueError('A VAV system requires all ternimal units with type = AirTerminal:SingleDuct:VAV:Reheat')
ErrorsFound=.true.
End If
End If
! Read AirflowNetwork Distribution system component: Detailed fan
! CurrentModuleObject='AIRFLOWNETWORK:DISTRIBUTION:COMPONENT DETAILED FAN'
! Deleted on Aug. 13, 2008
! Read AirflowNetwork Distribution system component: coil
CurrentModuleObject='AirflowNetwork:Distribution:Component:Coil'
DisSysNumOfCoils = GetNumObjectsFound(CurrentModuleObject)
If (DisSysNumOfCoils > 0) then
Allocate(DisSysCompCoilData(DisSysNumOfCoils))
Do i=1,DisSysNumOfCoils
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysCompCoilData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysCompCoilData(i)%Name = Alphas(1) ! Name of associated EPlus coil component
DisSysCompCoilData(i)%EPlusType = Alphas(2) ! coil type
DisSysCompCoilData(i)%L = Numbers(1) ! Air path length
DisSysCompCoilData(i)%D = Numbers(2) ! Air path hydraulic diameter
end do
Else
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone+1) then
! CALL ShowMessage(RoutineName//TRIM(CurrentModuleObject)//': This object is not used')
End If
End If
! Read AirflowNetwork Distribution system component: heat exchanger
CurrentModuleObject='AirflowNetwork:Distribution:Component:HeatExchanger'
DisSysNumOfHXs = GetNumObjectsFound(CurrentModuleObject)
If (DisSysNumOfHXs > 0) then
Allocate(DisSysCompHXData(DisSysNumOfHXs))
Do i=1,DisSysNumOfHXs
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysCompHXData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysCompHXData(i)%Name = Alphas(1) ! Name of associated EPlus heat exchange component
DisSysCompHXData(i)%EPlusType = Alphas(2) ! coil type
DisSysCompHXData(i)%L = Numbers(1) ! Air path length
DisSysCompHXData(i)%D = Numbers(2) ! Air path hydraulic diameter
DisSysCompHXData(i)%CoilParentExists = VerifyHeatExchangerParent(DisSysCompHXData(i)%EPlusType,DisSysCompHXData(i)%Name)
end do
End If
! Read AirflowNetwork Distribution system component: terminal unit
CurrentModuleObject='AirflowNetwork:Distribution:Component:TerminalUnit'
DisSysNumOfTermUnits = GetNumObjectsFound(CurrentModuleObject)
if (DisSysNumOfTermUnits > 0) then
Allocate(DisSysCompTermUnitData(DisSysNumOfTermUnits))
Do i=1,DisSysNumOfTermUnits
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysCompTermUnitData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysCompTermUnitData(i)%Name = Alphas(1) ! Name of associated EPlus coil component
DisSysCompTermUnitData(i)%EPlusType = Alphas(2) ! Terminal unit type
DisSysCompTermUnitData(i)%L = Numbers(1) ! Air path length
DisSysCompTermUnitData(i)%D = Numbers(2) ! Air path hydraulic diameter
end do
Else
! CALL ShowMessage(RoutineName//TRIM(CurrentModuleObject)//': This object is not used')
End If
! Get input data of constant pressure drop component
CurrentModuleObject='AirflowNetwork:Distribution:Component:ConstantPressureDrop'
DisSysNumOfCPDs = GetNumObjectsFound(CurrentModuleObject)
if (DisSysNumOfCPDs > 0) then
Allocate(DisSysCompCPDData(DisSysNumOfCPDs))
Do i=1,DisSysNumOfCPDs
CALL GetObjectItem(CurrentModuleObject,i,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),DisSysCompCPDData%Name,i-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
DisSysCompCPDData(i)%Name = Alphas(1) ! Name of constant pressure drop component
DisSysCompCPDData(i)%A = 1.0d0 ! cross section area
DisSysCompCPDData(i)%DP = Numbers(1) ! Pressure difference across the component
end do
Else
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone+1) then
! CALL ShowMessage(RoutineName//TRIM(CurrentModuleObject)//': This object is not used')
End If
End If
! Assign numbers of nodes and linkages
if (SimulateAirflowNetwork > AirflowNetworkControlSimple) then
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
NumOfNodesMultiZone = AirflowNetworkNumOfZones+AirflowNetworkNumOfExtNode
Else
NumOfNodesMultiZone = AirflowNetworkNumOfZones+NumOfExtNodes
end if
NumOfLinksMultiZone = AirflowNetworkNumOfSurfaces
AirflowNetworkNumOfNodes = NumOfNodesMultiZone
AirflowNetworkNumOfLinks = NumOfLinksMultiZone
end if
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone+1) then
AirflowNetworkNumOfNodes = NumOfNodesMultiZone+DisSysNumOfNodes
end if
! Assign node data
Allocate(AirflowNetworkNodeData(AirflowNetworkNumOfNodes))
! Zone node
Do I=1,AirflowNetworkNumOfZones
AirflowNetworkNodeData(i)%Name = MultizoneZoneData(i)%ZoneName
AirflowNetworkNodeData(i)%NodeTypeNum = 0
AirflowNetworkNodeData(i)%EPlusZoneNum =MultizoneZoneData(i)%ZoneNum
AirflowNetworkNodeData(i)%NodeHeight =MultizoneZoneData(i)%Height
End Do
! External node
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
Do I=AirflowNetworkNumOfZones+1,NumOfNodesMultiZone
AirflowNetworkNodeData(i)%Name = MultizoneExternalNodeData(i-AirflowNetworkNumOfZones)%Name
AirflowNetworkNodeData(i)%NodeTypeNum = 1
AirflowNetworkNodeData(i)%EPlusZoneNum =0
AirflowNetworkNodeData(i)%NodeHeight =MultizoneExternalNodeData(i-AirflowNetworkNumOfZones)%Height
AirflowNetworkNodeData(i)%ExtNodeNum = i-AirflowNetworkNumOfZones
End Do
Else ! Surface-Average input
Do I=AirflowNetworkNumOfZones+1,NumOfNodesMultiZone
n = I-AirflowNetworkNumOfZones
AirflowNetworkNodeData(i)%Name = MultizoneExternalNodeData(n)%Name
AirflowNetworkNodeData(i)%NodeTypeNum = 1
AirflowNetworkNodeData(i)%EPlusZoneNum =0
AirflowNetworkNodeData(i)%ExtNodeNum = n
End Do
End If
! Check whether Distribution system is simulated
If (AirflowNetworkNumOfNodes > NumOfNodesMultiZone) then
! Search node types: OAMixerOutdoorAirStreamNode, OutdoorAir:NodeList, and OutdoorAir:Node
J = 0
Do I=NumOfNodesMultiZone+1,AirflowNetworkNumOfNodes
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'OAMixerOutdoorAirStreamNode')) then
J = J+1
End If
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'OutdoorAir:NodeList')) then
J = J+1
End If
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'OutdoorAir:Node')) then
J = J+1
End If
End Do
Do I=NumOfNodesMultiZone+1,AirflowNetworkNumOfNodes
AirflowNetworkNodeData(i)%Name = DisSysNodeData(i-NumOfNodesMultiZone)%Name
AirflowNetworkNodeData(i)%NodeTypeNum = 0
AirflowNetworkNodeData(i)%EPlusZoneNum =0
AirflowNetworkNodeData(i)%NodeHeight = DisSysNodeData(i-NumOfNodesMultiZone)%Height
AirflowNetworkNodeData(i)%EPlusNodeNum = DisSysNodeData(i-NumOfNodesMultiZone)%EPlusNodeNum
! Get mixer information
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'AirLoopHVAC:ZoneMixer')) then
AirflowNetworkNodeData(i)%EPlusTypeNum = EPlusTypeNum_MIX
End If
! Get splitter information
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'AirLoopHVAC:ZoneSplitter')) then
AirflowNetworkNodeData(i)%EPlusTypeNum = EPlusTypeNum_SPL
End If
! Get outside air system information
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'AirLoopHVAC:OutdoorAirSystem')) then
AirflowNetworkNodeData(i)%EPlusTypeNum = EPlusTypeNum_OAN
End If
! Get OA system inlet information 'OAMixerOutdoorAirStreamNode' was specified as an outdoor air node implicitly
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'OAMixerOutdoorAirStreamNode') .AND. J==1) then
AirflowNetworkNodeData(i)%EPlusTypeNum = EPlusTypeNum_EXT
AirflowNetworkNodeData(i)%ExtNodeNum = AirflowNetworkNumOfExtNode+1
AirflowNetworkNodeData(i)%NodeTypeNum = 1
End If
If (SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'OutdoorAir:NodeList') .OR. &
SameString(DisSysNodeData(i-NumOfNodesMultiZone)%EPlusType,'OutdoorAir:Node')) then
If (J > 1) Then
AirflowNetworkNodeData(i)%EPlusTypeNum = EPlusTypeNum_EXT
AirflowNetworkNodeData(i)%ExtNodeNum = AirflowNetworkNumOfExtNode+1
AirflowNetworkNodeData(i)%NodeTypeNum = 1
Else
CALL ShowSevereError(RoutineName//'AirflowNetwork:Distribution:Node: The outdoor air node is found at ' &
//AirflowNetworkNodeData(i)%Name)
Call ShowContinueError('The node with Component Object Type = '// &
'OAMixerOutdoorAirStreamNode is not found. Please check inputs.')
ErrorsFound=.true.
End If
End If
End Do
end if
! Start to assembly AirflowNetwork Components
AirflowNetworkNumOfComps = AirflowNetworkNumOfDetOpenings+AirflowNetworkNumOfSimOpenings+AirflowNetworkNumOfSurCracks+ &
AirflowNetworkNumOfSurELA+DisSysNumOfLeaks+DisSysNumOfELRs+DisSysNumOfDucts+DisSysNumOfDampers+ &
DisSysNumOfCVFs+DisSysNumOfDetFans+DisSysNumOfCPDs+DisSysNumOfCoils+DisSysNumOfTermUnits+ &
AirflowNetworkNumOfExhFan+DisSysNumOfHXs+AirflowNetworkNumOfHorOpenings
Allocate(AirflowNetworkCompData(AirflowNetworkNumOfComps))
Do I=1,AirflowNetworkNumOfDetOpenings ! Detailed opening component
AirflowNetworkCompData(i)%Name = MultizoneCompDetOpeningData(i)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_DOP
AirflowNetworkCompData(i)%TypeNum = i
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = AirflowNetworkNumOfDetOpenings
Do I=1+J, AirflowNetworkNumOfSimOpenings+J ! Simple opening component
n = I-J
AirflowNetworkCompData(i)%Name = MultizoneCompSimpleOpeningData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_SOP
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+AirflowNetworkNumOfSimOpenings
Do I=1+J, AirflowNetworkNumOfSurCracks+J ! Surface crack component
n = I-J
AirflowNetworkCompData(i)%Name = MultizoneSurfaceCrackData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_SCR
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+AirflowNetworkNumOfSurCracks
Do I=1+J, AirflowNetworkNumOfSurELA+J ! Surface crack component
n = I-J
AirflowNetworkCompData(i)%Name = MultizoneSurfaceELAData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_SEL
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+AirflowNetworkNumOfSurELA
Do I=1+J, AirflowNetworkNumOfExhFan+J ! Zone exhaust fan component
n = I-J
AirflowNetworkCompData(i)%Name = MultizoneCompExhaustFanData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_EXF
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+AirflowNetworkNumOfExhFan
Do I=1+J, AirflowNetworkNumOfHorOpenings+J ! Distribution system crack component
n = I-J
AirflowNetworkCompData(i)%Name = MultizoneCompHorOpeningData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_HOP
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+AirflowNetworkNumOfHorOpenings
Do I=1+J, DisSysNumOfLeaks+J ! Distribution system crack component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompLeakData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_PLR
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+DisSysNumOfLeaks
Do I=1+J, DisSysNumOfELRs+J ! Distribution system effective leakage ratio component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompELRData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_ELR
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+DisSysNumOfELRs
Do I=1+J, DisSysNumOfDucts+J ! Distribution system effective leakage ratio component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompDuctData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_DWC
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+DisSysNumOfDucts
Do I=1+J, DisSysNumOfDampers+J ! Distribution system effective leakage ratio component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompDamperData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_DMP
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+DisSysNumOfDampers
Do I=1+J, DisSysNumOfCVFs+J ! Distribution system constant volume fan component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompCVFData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_CVF
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
AirflowNetworkCompData(i)%EPlusTypeNum = EPlusTypeNum_FAN
End Do
J = J+DisSysNumOfCVFs
Do I=1+J, DisSysNumOfDetFans+J ! Distribution system fan component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompDetFanData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_FAN
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
AirflowNetworkCompData(i)%EPlusTypeNum = EPlusTypeNum_FAN
End Do
J = J+DisSysNumOfDetFans
Do I=1+J, DisSysNumOfCPDs+J ! Distribution system constant pressure drop component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompCPDData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_CPD
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
End Do
J = J+DisSysNumOfCPDs
Do I=1+J, DisSysNumOfCoils+J ! Distribution system coil component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompCoilData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_COI
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
AirflowNetworkCompData(i)%EPlusTypeNum = EPlusTypeNum_COI
End Do
J = J+DisSysNumOfCoils
Do I=1+J, DisSysNumOfTermUnits+J ! Terminal unit component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompTermUnitData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_TMU
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
AirflowNetworkCompData(i)%EPlusTypeNum = EPlusTypeNum_RHT
End Do
J = J+DisSysNumOfTermUnits
Do I=1+J, DisSysNumOfHXs+J ! Distribution system heat exchanger component
n = I-J
AirflowNetworkCompData(i)%Name = DisSysCompHXData(n)%Name
AirflowNetworkCompData(i)%CompTypeNum = CompTypeNum_HEX
AirflowNetworkCompData(i)%TypeNum = n
AirflowNetworkCompData(i)%EPlusName = ' '
AirflowNetworkCompData(i)%EPlusCompName = ' '
AirflowNetworkCompData(i)%EPlusType = ' '
AirflowNetworkCompData(i)%CompNum = i
AirflowNetworkCompData(i)%EPlusTypeNum = EPlusTypeNum_HEX
End Do
! Assign linkage data
! Read AirflowNetwork linkage data
CurrentModuleObject='AirflowNetwork:Distribution:Linkage'
DisSysNumOfLinks = GetNumObjectsFound(CurrentModuleObject)
If (DisSysNumOfLinks > 0 .AND. SimulateAirflowNetwork .GT. AirflowNetworkControlMultizone) then ! Multizone + Distribution
AirflowNetworkNumOfLinks = NumOfLinksMultiZone+DisSysNumOfLinks
Allocate(AirflowNetworkLinkageData(DisSysNumOfLinks+AirflowNetworkNumOfSurfaces))
Else ! Multizone only
Allocate(AirflowNetworkLinkageData(AirflowNetworkNumOfSurfaces))
End If
! Assign Mutilzone linkage based on surfaces, by assuming every surface has a crack or opening
J=0
Do count=1, AirflowNetworkNumOfSurfaces
if (MultizoneSurfaceData(count)%SurfNum == 0) CYCLE
AirflowNetworkLinkageData(count)%Name = MultizoneSurfaceData(count)%SurfName
AirflowNetworkLinkageData(count)%NodeNums(1) = MultizoneSurfaceData(count)%NodeNums(1)
AirflowNetworkLinkageData(count)%NodeNums(2) = MultizoneSurfaceData(count)%NodeNums(2)
AirflowNetworkLinkageData(count)%CompName = MultizoneSurfaceData(count)%OpeningName
AirflowNetworkLinkageData(count)%ZoneNum = 0
AirflowNetworkLinkageData(count)%LinkNum = count
AirflowNetworkLinkageData(count)%NodeHeights(1) = MultizoneSurfaceData(count)%CHeight
AirflowNetworkLinkageData(count)%NodeHeights(2) = MultizoneSurfaceData(count)%CHeight
If (.NOT. WorldCoordSystem) then
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(1))%EPlusZoneNum>0) then
AirflowNetworkLinkageData(count)%NodeHeights(1)=AirflowNetworkLinkageData(count)%NodeHeights(1)- &
Zone(AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(1))%EPlusZoneNum)%OriginZ
End If
If (AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(2))%EPlusZoneNum>0) then
AirflowNetworkLinkageData(count)%NodeHeights(2)=AirflowNetworkLinkageData(count)%NodeHeights(2)- &
Zone(AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(2))%EPlusZoneNum)%OriginZ
End If
End If
! Find component number
found = .FALSE.
Do i=1,AirflowNetworkNumOfComps
if (AirflowNetworkLinkageData(count)%CompName == AirflowNetworkCompData(i)%Name) then
AirflowNetworkLinkageData(count)%CompNum = i
found = .TRUE.
if (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_DOP) then
J = J+1
AirflowNetworkLinkageData(count)%DetOpenNum = J
MultizoneSurfaceData(count)%Multiplier = Surface(MultizoneSurfaceData(count)%SurfNum)%Multiplier
IF (Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt < 10.0d0 .OR. &
Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt > 170.0d0) then
Call ShowWarningError('An AirflowNetwork:Multizone:Surface object has an air-flow opening corresponding to')
Call ShowContinueError('window or door = '//Trim(MultizoneSurfaceData(count)%SurfName)//', which is within ')
Call ShowContinueError('10 deg of being horizontal. Airflows through large horizontal openings are poorly')
Call ShowContinueError('modeled in the AirflowNetwork model resulting in only one-way airflow.')
End If
If (.NOT. (SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_Window &
.OR. SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_GlassDoor &
.OR. SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_Door)) then
CALL ShowSevereError(RoutineName//'AirflowNetworkComponent: The opening must be ' &
//'assigned to a window, door or glassdoor at '//AirflowNetworkLinkageData(count)%Name)
ErrorsFound=.true.
End If
If (SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_Door &
.OR. SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_GlassDoor) then
If (MultizoneCompDetOpeningData(AirflowNetworkCompData(i)%TypeNum)%LVOType == 2) then
CALL ShowSevereError(RoutineName//'AirflowNetworkComponent: The opening with horizontally pivoted ' &
//'type must be assigned to a window surface at '//AirflowNetworkLinkageData(count)%Name)
ErrorsFound=.true.
End If
End If
end if
if (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_SOP) then
MultizoneSurfaceData(count)%Multiplier = Surface(MultizoneSurfaceData(count)%SurfNum)%Multiplier
IF (Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt < 10.0d0 .OR. &
Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt > 170.0d0) then
Call ShowSevereError('An AirflowNetwork:Multizone:Surface object has an air-flow opening corresponding to')
Call ShowContinueError('window or door = '//Trim(MultizoneSurfaceData(count)%SurfName)//', which is within')
Call ShowContinueError('10 deg of being horizontal. Airflows through horizontal openings are not allowed.')
Call ShowContinueError('AirflowNetwork:Multizone:Component:SimpleOpening = ' &
//Trim(AirflowNetworkCompData(i)%Name))
ErrorsFound=.true.
End If
If (.NOT. (SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_Window &
.OR. SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_GlassDoor &
.OR. SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_Door)) then
CALL ShowSevereError(RoutineName//'AirflowNetworkComponent: The opening must be ' &
//'assigned to a window, door or glassdoor at '//AirflowNetworkLinkageData(count)%Name)
ErrorsFound=.true.
End If
end if
if (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_HOP) then
MultizoneSurfaceData(count)%Multiplier = Surface(MultizoneSurfaceData(count)%SurfNum)%Multiplier
! Get linkage height from upper and lower zones
If (MultizoneZoneData(AirflowNetworkLinkageData(count)%NodeNums(1))%ZoneNum > 0) Then
AirflowNetworkLinkageData(count)%NodeHeights(1) = &
Zone(MultizoneZoneData(AirflowNetworkLinkageData(count)%NodeNums(1))%ZoneNum)%CENTROID%Z
End If
If (AirflowNetworkLinkageData(count)%NodeNums(2) .LE. AirflowNetworkNumOfZones) Then
If (MultizoneZoneData(AirflowNetworkLinkageData(count)%NodeNums(2))%ZoneNum > 0) Then
AirflowNetworkLinkageData(count)%NodeHeights(2) = &
Zone(MultizoneZoneData(AirflowNetworkLinkageData(count)%NodeNums(2))%ZoneNum)%CENTROID%Z
End If
End If
If (AirflowNetworkLinkageData(count)%NodeNums(2) .GT. AirflowNetworkNumOfZones) Then
CALL ShowSevereError(RoutineName//'AirflowNetworkComponent: The horizontal opening must be ' &
//'located between two thermal zones at '//AirflowNetworkLinkageData(count)%Name)
Call ShowContinueError('This component is exposed to outdoors.')
ErrorsFound=.true.
Else
If (.NOT. (MultizoneZoneData(AirflowNetworkLinkageData(count)%NodeNums(1))%ZoneNum > 0 .AND. &
MultizoneZoneData(AirflowNetworkLinkageData(count)%NodeNums(2))%ZoneNum > 0)) Then
CALL ShowSevereError(RoutineName//'AirflowNetworkComponent: The horizontal opening must be ' &
//'located between two thermal zones at '//AirflowNetworkLinkageData(count)%Name)
ErrorsFound=.true.
End If
End If
IF (.NOT. (Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt > 170.0d0 .AND. &
Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt < 190.0d0) .AND. &
.NOT. (Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt > -10.0d0 .AND. &
Surface(MultizoneSurfaceData(count)%SurfNum)%Tilt < 10.0d0)) then
Call ShowWarningError('An AirflowNetwork:Multizone:Surface object has an air-flow opening corresponding to')
Call ShowContinueError('window or door = '//Trim(MultizoneSurfaceData(count)%SurfName)//', which is above')
Call ShowContinueError('10 deg of being horizontal. Airflows through non-horizontal openings are not modeled')
Call ShowContinueError('with the object of AirflowNetwork:Multizone:Component:HorizontalOpening = ' &
//Trim(AirflowNetworkCompData(i)%Name))
End If
If (.NOT. (SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_Window &
.OR. SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_GlassDoor &
.OR. SurfaceWindow(MultizoneSurfaceData(count)%SurfNum)%OriginalClass == SurfaceClass_Door)) then
CALL ShowSevereError(RoutineName//'AirflowNetworkComponent: The opening must be ' &
//'assigned to a window, door or glassdoor at '//AirflowNetworkLinkageData(count)%Name)
ErrorsFound=.true.
End If
end if
Exit
end if
end do
if (.NOT. found) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': The component is not defined in '// &
AirflowNetworkLinkageData(count)%Name )
ErrorsFound=.true.
end if
End Do
If (DisSysNumOfLinks > 0 .AND. SimulateAirflowNetwork .GT. AirflowNetworkControlMultizone) then ! Distribution
AirflowNetworkLinkageData%ZoneNum = 0
do count=AirflowNetworkNumOfSurfaces+1,AirflowNetworkNumOfLinks
CALL GetObjectItem(CurrentModuleObject,count-AirflowNetworkNumOfSurfaces,Alphas,NumAlphas,Numbers,NumNumbers,IOStatus, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(Alphas(1),AirflowNetworkLinkageData%Name,count-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) Alphas(1)='xxxxx'
ENDIF
AirflowNetworkLinkageData(count)%Name = Alphas(1)
AirflowNetworkLinkageData(count)%NodeNames(1) = Alphas(2)
AirflowNetworkLinkageData(count)%NodeHeights(1) = 0.0d0
AirflowNetworkLinkageData(count)%NodeNames(2) = Alphas(3)
AirflowNetworkLinkageData(count)%NodeHeights(2) = 0.0d0
AirflowNetworkLinkageData(count)%CompName = Alphas(4)
AirflowNetworkLinkageData(count)%ZoneName = Alphas(5)
AirflowNetworkLinkageData(count)%LinkNum = count
if (.NOT. lAlphaBlanks(5)) then
AirflowNetworkLinkageData(count)%ZoneNum = FindIteminList(AirflowNetworkLinkageData(count)%ZoneName,Zone%Name,NumOfZones)
IF (AirflowNetworkLinkageData(count)%ZoneNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': Invalid '//TRIM(cAlphaFields(5))//' given = ' &
//TRIM(AirflowNetworkLinkageData(count)%ZoneName))
ErrorsFound=.true.
ENDIF
end if
if (Alphas(2) == Alphas(3)) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//', '//TRIM(cAlphaFields(2))//' = '//TRIM(cAlphaFields(3))// &
' in '//TRIM(AirflowNetworkLinkageData(count)%Name))
ErrorsFound = .TRUE.
end if
! Find component number
found = .FALSE.
Do i=1,AirflowNetworkNumOfComps
if (AirflowNetworkLinkageData(count)%CompName == AirflowNetworkCompData(i)%Name) then
AirflowNetworkLinkageData(count)%CompNum = i
found = .TRUE.
Exit
end if
end do
if (.NOT. found) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': The '//TRIM(cAlphaFields(4))//' is not defined in ' &
//AirflowNetworkLinkageData(count)%Name )
ErrorsFound=.true.
end if
! Find Node number
found = .FALSE.
Do i=1,AirflowNetworkNumOfNodes
if (AirflowNetworkLinkageData(count)%NodeNames(1) == AirflowNetworkNodeData(i)%Name) then
AirflowNetworkLinkageData(count)%NodeNums(1) = i
AirflowNetworkLinkageData(count)%NodeHeights(1) = AirflowNetworkLinkageData(count)%NodeHeights(1)+ &
AirflowNetworkNodeData(i)%NodeHeight
found = .TRUE.
Exit
end if
end do
if (.NOT. found) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': The '//TRIM(cAlphaFields(2))//' is not ' &
//'found in the node data ' //AirflowNetworkLinkageData(count)%Name )
ErrorsFound=.true.
end if
Do i=1,AirflowNetworkNumOfNodes
if (AirflowNetworkLinkageData(count)%NodeNames(2) == AirflowNetworkNodeData(i)%Name) then
AirflowNetworkLinkageData(count)%NodeNums(2) = i
AirflowNetworkLinkageData(count)%NodeHeights(2) = AirflowNetworkLinkageData(count)%NodeHeights(2)+ &
AirflowNetworkNodeData(i)%NodeHeight
found = .TRUE.
Exit
end if
end do
if (.NOT. found) then
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//': The '//TRIM(cAlphaFields(3))//' is not ' &
//'found in the node data ' //AirflowNetworkLinkageData(count)%Name )
ErrorsFound=.true.
end if
end do
Else
if (SimulateAirflowNetwork > AirflowNetworkControlMultizone+1) then
CALL ShowSevereError(RoutineName//'An '//TRIM(CurrentModuleObject)//' object is required but not found.')
ErrorsFound=.true.
End If
End If
! Ensure no duplicated names in AirflowNetwork component objects
Do i=1,AirflowNetworkNumOfComps
Do J=i+1,AirflowNetworkNumOfComps
If (SameString(AirflowNetworkCompData(i)%Name,AirflowNetworkCompData(j)%Name)) then
! SurfaceAirflowLeakageNames
If (i .le. 4 .and. j .le. 4) then
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_DOP) &
CompName(1) = 'AirflowNetwork:MultiZone:Component:DetailedOpening'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_SOP) &
CompName(1) = 'AirflowNetwork:MultiZone:Component:SimpleOpening'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_SCR) &
CompName(1) = 'AirflowNetwork:MultiZone:Surface:Crack'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_SEL) &
CompName(1) = 'AirflowNetwork:MultiZone:Surface:EffectiveLeakageArea'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_DOP) &
CompName(2) = 'AirflowNetwork:MultiZone:Component:DetailedOpening'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_SOP) &
CompName(2) = 'AirflowNetwork:MultiZone:Component:SimpleOpening'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_SCR) &
CompName(2) = 'AirflowNetwork:MultiZone:Surface:Crack'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_SEL) &
CompName(2) = 'AirflowNetwork:MultiZone:Surface:EffectiveLeakageArea'
CALL ShowSevereError(RoutineName//'Duplicated component names are found = ' &
//Trim(AirflowNetworkCompData(i)%Name))
CALL ShowContinueError('A unique component name is required in both objects '//Trim(CompName(1)) &
//' and '//Trim(CompName(2)))
ErrorsFound=.true.
End If
! Distribution component
If (i > 4 .and. j > 4) then
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_PLR) &
CompName(1) = 'AirflowNetwork:Distribution:Component:Leak'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_DWC) &
CompName(1) = 'AirflowNetwork:Distribution:Component:Duct'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_ELR) &
CompName(1) = 'AirflowNetwork:Distribution:Component:LeakageRatio'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_DMP) &
CompName(1) = 'AIRFLOWNETWORK:DISTRIBUTION:COMPONENT DAMPER'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_CVF) &
CompName(1) = 'AirflowNetwork:Distribution:Component:Fan'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_CPD) &
CompName(1) = 'AirflowNetwork:Distribution:Component:ConstantPressureDrop'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_COI) &
CompName(1) = 'AirflowNetwork:Distribution:Component:Coil'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_TMU) &
CompName(1) = 'AirflowNetwork:Distribution:Component:TerminalUnit'
If (AirflowNetworkCompData(i)%CompTypeNum == CompTypeNum_HEX) &
CompName(1) = 'AirflowNetwork:Distribution:Component:HeatExchanger'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_PLR) &
CompName(2) = 'AirflowNetwork:Distribution:Component:Leak'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_DWC) &
CompName(2) = 'AirflowNetwork:Distribution:Component:Duct'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_ELR) &
CompName(2) = 'AirflowNetwork:Distribution:Component:LeakageRatio'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_DMP) &
CompName(2) = 'AIRFLOWNETWORK:DISTRIBUTION:COMPONENT DAMPER'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_CVF) &
CompName(2) = 'AirflowNetwork:Distribution:Component:Fan'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_CPD) &
CompName(2) = 'AirflowNetwork:Distribution:Component:ConstantPressureDrop'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_COI) &
CompName(2) = 'AirflowNetwork:Distribution:Component:Coil'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_TMU) &
CompName(2) = 'AirflowNetwork:Distribution:Component:TerminalUnit'
If (AirflowNetworkCompData(j)%CompTypeNum == CompTypeNum_HEX) &
CompName(2) = 'AirflowNetwork:Distribution:Component:HeatExchanger'
CALL ShowSevereError(RoutineName//'Duplicated component names are found = ' &
//Trim(AirflowNetworkCompData(i)%Name))
CALL ShowContinueError('A unique component name is required in both objects '//Trim(CompName(1)) &
//' and '//Trim(CompName(2)))
ErrorsFound=.true.
End If
End IF
End Do
End Do
! Node and component validation
do count=1,AirflowNetworkNumOfLinks
NodeFound = .FALSE.
do i=1,AirflowNetworkNumOfNodes
if (i == AirflowNetworkLinkageData(count)%NodeNums(1)) then
NodeFound = .TRUE.
Exit
end if
end do
if (.NOT. NodeFound) then
If (count .le. AirflowNetworkNumOfSurfaces) then
CALL ShowSevereError(RoutineName//TRIM(AirflowNetworkLinkageData(count)%NodeNames(1))// &
' in AIRFLOWNETWORK:MULTIZONE:SURFACE = ' &
//TRIM(AirflowNetworkLinkageData(count)%Name)//' is not found')
Else
CALL ShowSevereError(RoutineName//TRIM(AirflowNetworkLinkageData(count)%NodeNames(1))// &
' in AIRFLOWNETWORK:DISTRIBUTION:LINKAGE = '//TRIM(AirflowNetworkLinkageData(count)%Name)// &
' is not found in AIRFLOWNETWORK:DISTRIBUTION:NODE objects.')
End If
ErrorsFound = .TRUE.
end if
NodeFound = .FALSE.
do i=1,AirflowNetworkNumOfNodes
if (i == AirflowNetworkLinkageData(count)%NodeNums(2)) then
NodeFound = .TRUE.
Exit
end if
end do
if (.NOT. NodeFound) then
If (count .le. AirflowNetworkNumOfSurfaces) then
CALL ShowSevereError(RoutineName//TRIM(AirflowNetworkLinkageData(count)%NodeNames(1))// &
' in AIRFLOWNETWORK:MULTIZONE:SURFACE = ' &
//TRIM(AirflowNetworkLinkageData(count)%Name)//' is not found')
Else
CALL ShowSevereError(RoutineName//TRIM(AirflowNetworkLinkageData(count)%NodeNames(2))// &
' in AIRFLOWNETWORK:DISTRIBUTION:LINKAGE = '//TRIM(AirflowNetworkLinkageData(count)%Name)// &
' is not found in AIRFLOWNETWORK:DISTRIBUTION:NODE objects.')
End If
ErrorsFound = .TRUE.
end if
CompFound = .FALSE.
do i=1,AirflowNetworkNumOfComps
if (i == AirflowNetworkLinkageData(count)%CompNum) then
CompFound = .TRUE.
end if
end do
if (.NOT. CompFound) then
CALL ShowSevereError(RoutineName//'Component = '//TRIM(AirflowNetworkLinkageData(count)%CompName)//&
' in AIRFLOWNETWORK:DISTRIBUTION:LINKAGE = '//TRIM(AirflowNetworkLinkageData(count)%Name)// &
' is not found in AirflowNetwork Component Data objects.')
ErrorsFound = .TRUE.
end if
end do
! Ensure every AirflowNetworkNode is used in AirflowNetworkLinkage
do count=1,AirflowNetworkNumOfNodes
NodeFound1 = .FALSE.
NodeFound2 = .FALSE.
do i=1,AirflowNetworkNumOfLinks
if (count .EQ. AirflowNetworkLinkageData(i)%NodeNums(1)) then
NodeFound1 = .True.
end if
if (count .EQ. AirflowNetworkLinkageData(i)%NodeNums(2)) then
NodeFound2 = .True.
end if
end do
if ((.NOT. NodeFound1) .AND. Count > NumOfNodesMultiZone .AND. AirflowNetworkNodeData(count)%ExtNodeNum == 0) then
CALL ShowSevereError(RoutineName//'AIRFLOWNETWORK:DISTRIBUTION:NODE = '//TRIM(AirflowNetworkNodeData(count)%Name) &
//' is not found as Node 1 Name in AIRFLOWNETWORK:DISTRIBUTION:LINKAGE')
Call ShowContinueError('Each non-external AIRFLOWNETWORK:DISTRIBUTION:NODE has to be defined as Node 1 once in ' &
//'AIRFLOWNETWORK:DISTRIBUTION:LINKAGE')
ErrorsFound=.true.
end if
if ((.NOT. NodeFound2) .AND. Count > NumOfNodesMultiZone .AND. AirflowNetworkNodeData(count)%ExtNodeNum == 0) then
CALL ShowSevereError(RoutineName//'AIRFLOWNETWORK:DISTRIBUTION:NODE = '//TRIM(AirflowNetworkNodeData(count)%Name) &
//' is not found as Node 2 Name in AIRFLOWNETWORK:DISTRIBUTION:LINKAGE')
Call ShowContinueError('Each non-external AIRFLOWNETWORK:DISTRIBUTION:NODE has to be defined as Node 2 once in ' &
//'AIRFLOWNETWORK:DISTRIBUTION:LINKAGE')
ErrorsFound=.true.
end if
if ((.NOT. NodeFound1) .AND. (.NOT. NodeFound2) .AND. Count > NumOfNodesMultiZone &
.AND. AirflowNetworkNodeData(count)%ExtNodeNum > 0) then
CALL ShowSevereError(RoutineName//'AIRFLOWNETWORK:DISTRIBUTION:NODE = '//TRIM(AirflowNetworkNodeData(count)%Name) &
//' is not found as Node 1 Name or Node 2 Name in AIRFLOWNETWORK:DISTRIBUTION:LINKAGE')
Call ShowContinueError('This external AIRFLOWNETWORK:DISTRIBUTION:NODE has to be defined in ' &
//'AIRFLOWNETWORK:DISTRIBUTION:LINKAGE')
ErrorsFound=.true.
end if
end do
! Ensure there is at least one node defined as EXTERNAL node
NodeFound = .FALSE.
do count=1,AirflowNetworkNumOfNodes
if (AirflowNetworkNodeData(count)%ExtNodeNum > 0) then
NodeFound = .True.
end if
end do
if (.NOT. NodeFound) then
CALL ShowSevereError(RoutineName//'No External Nodes found in AirflowNetwork:Multizone:ExternalNode. '// &
'There must be at least 1 external node defined.')
ErrorsFound=.true.
end if
if (AirflowNetworkSimu%iWPCCntr == iWPCCntr_Input) then
do count=1,AirflowNetworkNumOfSurfaces
If (AirflowNetworkLinkageData(count)%NodeNums(1) == 0) then
CALL ShowSevereError('The surface is not found '// &
'in AIRFLOWNETWORK:MULTIZONE:SURFACE = '//TRIM(AirflowNetworkLinkageData(count)%Name))
ErrorsFound=.true.
End If
If (AirflowNetworkLinkageData(count)%NodeNums(2) == 0) then
CALL ShowSevereError('The external node is not found '// &
'in AIRFLOWNETWORK:MULTIZONE:SURFACE = '//TRIM(AirflowNetworkLinkageData(count)%Name))
ErrorsFound=.true.
End If
end do
End If
! Provide a warning when a door component is assigned as envelope leakage
if (.Not. ErrorsFound) THEN
do count=1,AirflowNetworkNumOfSurfaces
if (AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(1))%ExtNodeNum > 0 .AND. &
AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(2))%EPlusZoneNum > 0 .AND. &
AirflowNetworkLinkageData(count)%CompNum > 0) then
if (AirflowNetworkCompData(AirflowNetworkLinkageData(count)%CompNum)%CompTypeNum == CompTypeNum_SOP) then
! CALL ShowWarningError('A door component is assigned between an external node and a thermal zone ' &
! //'in AirflowNetwork linkage data = '//TRIM(AirflowNetworkLinkageData(count)%Name))
! CALL ShowContinueError('This represents a large opening between indoor and outdoors. You may want to ' &
! //'reconsider your input.')
end if
end if
if (AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(2))%ExtNodeNum > 0 .AND. &
AirflowNetworkNodeData(AirflowNetworkLinkageData(count)%NodeNums(1))%EPlusZoneNum > 0 .AND. &
AirflowNetworkLinkageData(count)%CompNum > 0) then
if (AirflowNetworkCompData(AirflowNetworkLinkageData(count)%CompNum)%CompTypeNum == CompTypeNum_SOP) then
! CALL ShowWarningError('A door component is assigned between an external node and a thermal zone ' &
! //'in AirflowNetwork linkage data = '//TRIM(AirflowNetworkLinkageData(count)%Name))
! CALL ShowContinueError('This represents a large opening between indoor and outdoors. You may want to ' &
! //'reconsider your input.')
end if
end if
end do
End If
! Ensure the name of each heat exchanger is shown either once ot twice in the field of
If (SimulateAirflowNetwork == AirflowNetworkControlSimpleADS .OR. SimulateAirflowNetwork == AirflowNetworkControlMultiADS) Then
Do I=1,DisSysNumOfHXs
count = 0
Do j=1,AirflowNetworkNumOfLinks
If (Samestring(AirflowNetworkLinkageData(j)%CompName,DisSysCompHXData(i)%Name)) Then
count = count+1
End If
End Do
If (DisSysCompHXData(i)%CoilParentExists .AND. count .NE. 2) Then
CALL ShowSevereError(RoutineName//'The inputs of component name field as a heat exchanger in ' &
//'AIRFLOWNETWORK:DISTRIBUTION:LINKAGE is not correct')
Call ShowContinueError('The entered name of heat enchanger is '//Trim(DisSysCompHXData(i)%Name)// &
' in AirflowNetwork:Distribution:Component:HeatExchanger objects')
Call ShowContinueError('The correct apperance number is 2. The entered apperance number is '//TRIM(RoundSigDigits(count,0)))
ErrorsFound=.true.
End If
If ((.NOT. DisSysCompHXData(i)%CoilParentExists).AND. count .NE. 1) Then
CALL ShowSevereError(RoutineName//'The inputs of component name field as a heat exchanger in ' &
//'AIRFLOWNETWORK:DISTRIBUTION:LINKAGE is not correct')
Call ShowContinueError('The entered name of heat enchanger is '//Trim(DisSysCompHXData(i)%Name)// &
' in AirflowNetwork:Distribution:Component:HeatExchanger objects')
Call ShowContinueError('The correct apperance number is 1. The entered apperance number is '//TRIM(RoundSigDigits(count,0)))
ErrorsFound=.true.
End If
End Do
End If
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found getting inputs. Previous error(s) cause program termination.')
END IF
DEALLOCATE(Alphas)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(Numbers)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
IF (.Not. ErrorsFound) THEN
CALL AllocateAndInitData
ENDIF
RETURN
END SUBROUTINE GetAirflowNetworkInput