Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE ValidateExhaustFanInput
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Dec. 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine validate zone exhaust fan and associated surface
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: SameString
USE DataZoneEquipment, ONLY: ZoneEquipList,ZoneExhaustFan_Num
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER (len=*), PARAMETER :: RoutineName='ValidateExhaustFanInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
integer I,j,k
LOGICAL,SAVE :: OneTimeFlag = .True.
LOGICAL :: ErrorsFound=.false.
LOGICAL found
INTEGER EquipTypeNum ! Equipment type number
CHARACTER(len=MaxNameLength) :: CurrentModuleObject
! Validate supply and return connections
if (OneTimeFlag) then
CurrentModuleObject = 'AirflowNetwork:MultiZone:Component:ZoneExhaustFan'
If (ANY(ZoneEquipConfig%IsControlled)) then
ALLOCATE(AirflowNetworkZoneExhaustFan(NumOfZones))
AirflowNetworkZoneExhaustFan = .FALSE.
End If
! Ensure the number of exhaust fan defined in the AirflowNetwork model matches the number of Zone Exhaust Fan objects
If (NumOfExhaustFans .NE. AirflowNetworkNumOfExhFan) Then
CALL ShowSevereError(RoutineName//'The number of '//TRIM(CurrentModuleObject) &
//' is not equal to the number of Fan:ZoneExhaust fans defined in ZoneHVAC:EquipmentConnections')
CALL ShowContinueError('The number of '//TRIM(CurrentModuleObject)//' is ' &
//TRIM(RoundSigDigits(AirflowNetworkNumOfExhFan)))
CALL ShowContinueError('The number of Zone exhaust fans defined in ZoneHVAC:EquipmentConnections is ' &
//TRIM(RoundSigDigits(NumOfExhaustFans)))
ErrorsFound=.true.
END IF
Do i=1,AirflowNetworkNumOfExhFan
! Get zone number
DO j=1,NumOfZones
IF (.not. ZoneEquipConfig(j)%IsControlled) CYCLE
DO k=1,ZoneEquipConfig(j)%NumExhaustNodes
If (ZoneEquipConfig(j)%ExhaustNode(k) .EQ. MultizoneCompExhaustFanData(i)%InletNode) then
MultizoneCompExhaustFanData(i)%EPlusZoneNum = ZoneEquipConfig(j)%ActualZoneNum
Exit
End If
End Do
End Do
If (MultizoneCompExhaustFanData(i)%EPlusZoneNum == 0) then
CALL ShowSevereError(RoutineName//'Zone name in '//TRIM(CurrentModuleObject)//' = ' &
//TRIM(MultizoneCompExhaustFanData(i)%Name)//' does not match the zone name in ZoneHVAC:EquipmentConnections')
ErrorsFound=.true.
End If
! Ensure a surface using zone exhaust fan to expose to the same zone
found = .FALSE.
Do j=1,AirflowNetworkNumOfSurfaces
If (SameString(MultizoneSurfaceData(j)%OpeningName, MultizoneCompExhaustFanData(i)%Name)) then
found = .TRUE.
If (Surface(MultizoneSurfaceData(j)%SurfNum)%ExtBoundCond /= ExternalEnvironment) then
CALL ShowSevereError(RoutineName//'The surface using '//TRIM(CurrentModuleObject) &
//' is not an exterior surface: '//TRIM(MultizoneSurfaceData(j)%SurfName))
ErrorsFound=.true.
End If
Exit
End If
End Do
If (.NOT. found) then
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = ' &
//TRIM(MultizoneCompExhaustFanData(i)%Name)//' is defined and never used.')
ErrorsFound=.true.
Else
If (MultizoneCompExhaustFanData(i)%EPlusZoneNum .NE. Surface(MultizoneSurfaceData(j)%SurfNum)%Zone) then
CALL ShowSevereError(RoutineName//'Zone name in '//TRIM(CurrentModuleObject)//' = ' &
//TRIM(MultizoneCompExhaustFanData(i)%Name)//' does not match the zone name')
CALL ShowContinueError('the surface is exposed to ' //Trim(Surface(MultizoneSurfaceData(j)%SurfNum)%Name))
ErrorsFound=.true.
Else
AirflowNetworkZoneExhaustFan(MultizoneCompExhaustFanData(i)%EPlusZoneNum) = .TRUE.
End If
End If
End Do
! Ensure all zone exhaust fans are defined
DO j=1,NumOfZones
IF (.not. ZoneEquipConfig(j)%IsControlled) CYCLE
DO EquipTypeNum = 1, ZoneEquipList(j)%NumOfEquipTypes
If (ZoneEquipList(j)%EquipType_Num(EquipTypeNum) == ZoneExhaustFan_Num) Then
found = .FALSE.
Do k=1,ZoneEquipConfig(j)%NumExhaustNodes
Do i=1,AirflowNetworkNumOfExhFan
If (ZoneEquipConfig(j)%ExhaustNode(k) .EQ. MultizoneCompExhaustFanData(i)%InletNode) then
MultizoneCompExhaustFanData(i)%EPlusZoneNum = ZoneEquipConfig(j)%ActualZoneNum
found = .TRUE.
End If
End Do
If (.NOT. found) then
CALL ShowSevereError(RoutineName//'Fan:ZoneExhaust is not defined in '//TRIM(CurrentModuleObject))
CALL ShowContinueError('Zone Air Exhaust Node in ZoneHVAC:EquipmentConnections =' &
//TRIM(NodeID(ZoneEquipConfig(j)%ExhaustNode(k))))
ErrorsFound=.true.
End If
End Do
End If
End Do
End Do
OneTimeFlag = .False.
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Program terminates for preceding reason(s).')
ENDIF
end if
END SUBROUTINE ValidateExhaustFanInput