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 SetupNodeVarsForReporting
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN September
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is called when the indicated number of
! Nodes have been found (TOTAL NODE NUMBER) or when HVAC warmup is
! complete, whichever condition is reached first.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataErrorTracking, ONLY: AbortProcessing ! used here to determine if this routine called during fatal error processing
USE DataContaminantBalance, ONLY: Contaminant
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER NumNode ! Loop Variable
INTEGER Count0
CHARACTER(len=20) ChrOut
CHARACTER(len=20) ChrOut1
CHARACTER(len=20) ChrOut2
IF (.not. NodeVarsSetup) THEN
IF (.not. AbortProcessing) THEN
ALLOCATE(MoreNodeInfo(NumOfUniqueNodeNames))
DO NumNode = 1, NumOfUniqueNodeNames
! Setup Report variables for the Nodes for HVAC Reporting, CurrentModuleObject='Node Name'
CALL SetupOutputVariable('System Node Temperature [C]', Node(NumNode)%Temp,'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Mass Flow Rate [kg/s]', &
Node(NumNode)%MassFlowRate,'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Humidity Ratio [kgWater/kgDryAir]', Node(NumNode)%HumRat,'System','Average', &
NodeID(NumNode))
CALL SetupOutputVariable('System Node Setpoint Temperature [C]', &
Node(NumNode)%TempSetPoint,'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Setpoint High Temperature [C]', Node(NumNode)%TempSetPointHi,'System','Average', &
NodeID(NumNode))
CALL SetupOutputVariable('System Node Setpoint Low Temperature [C]', Node(NumNode)%TempSetPointLo,'System','Average', &
NodeID(NumNode))
CALL SetupOutputVariable('System Node Setpoint Humidity Ratio [kgWater/kgDryAir]', Node(NumNode)%HumRatSetPoint, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Setpoint Minimum Humidity Ratio [kgWater/kgDryAir]', Node(NumNode)%HumRatMin, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Setpoint Maximum Humidity Ratio [kgWater/kgDryAir]', Node(NumNode)%HumRatMax, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Relative Humidity [%]', MoreNodeInfo(NumNode)%RelHumidity,'System','Average', &
NodeID(NumNode))
CALL SetupOutputVariable('System Node Pressure [Pa]', Node(NumNode)%Press,'System','Average', &
NodeID(NumNode))
CALL SetupOutputVariable('System Node Standard Density Volume Flow Rate [m3/s]', &
MoreNodeInfo(NumNode)%VolFlowRateStdRho, 'System', &
'Average', NodeID(NumNode))
IF (Node(NumNode)%FluidType == NodeType_Air .OR. Node(NumNode)%FluidType == NodeType_Water) THEN
! setup volume flow rate report for actual/current density
CALL SetupOutputVariable('System Node Current Density Volume Flow Rate [m3/s]', &
MoreNodeInfo(NumNode)%VolFlowRateCrntRho, 'System', &
'Average', NodeID(NumNode))
CALL SetupOutputVariable('System Node Current Density [kg/m3]', &
MoreNodeInfo(NumNode)%Density, 'System', &
'Average', NodeID(NumNode))
ENDIF
CALL SetupOutputVariable('System Node Enthalpy [J/kg]', MoreNodeInfo(NumNode)%ReportEnthalpy, 'System', &
'Average', NodeID(NumNode))
CALL SetupOutputVariable('System Node Wetbulb Temperature [C]', MoreNodeInfo(NumNode)%WetbulbTemp, 'System', &
'Average', NodeID(NumNode))
CALL SetupOutputVariable('System Node Dewpoint Temperature [C]', MoreNodeInfo(NumNode)%AirDewpointTemp, 'System', &
'Average', NodeID(NumNode))
CALL SetupOutputVariable('System Node Quality []', Node(NumNode)%Quality, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Height [m]', Node(NumNode)%Height, &
'System','Average',NodeID(NumNode))
IF (DisplayAdvancedReportVariables) THEN
CALL SetupOutputVariable('System Node Minimum Temperature [C]', &
Node(NumNode)%TempMin,'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Maximum Temperature [C]', &
Node(NumNode)%TempMax,'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Minimum Limit Mass Flow Rate [kg/s]', Node(NumNode)%MassFlowRateMin, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Maximum Limit Mass Flow Rate [kg/s]', Node(NumNode)%MassFlowRateMax, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Minimum Available Mass Flow Rate [kg/s]', Node(NumNode)%MassFlowRateMinAvail, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Maximum Available Mass Flow Rate [kg/s]', Node(NumNode)%MassFlowRateMaxAvail, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Setpoint Mass Flow Rate [kg/s]', Node(NumNode)%MassFlowRateSetPoint, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Requested Mass Flow Rate [kg/s]', Node(NumNode)%MassFlowRateRequest, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Last Timestep Temperature [C]', Node(NumNode)%TempLastTimestep, &
'System','Average',NodeID(NumNode))
CALL SetupOutputVariable('System Node Last Timestep Enthalpy [J/kg]', Node(NumNode)%EnthalpyLastTimestep, &
'System','Average',NodeID(NumNode))
ENDIF
IF (Contaminant%CO2Simulation) Then
CALL SetupOutputVariable('System Node CO2 Concentration [ppm]', Node(NumNode)%CO2,'System', &
'Average',NodeID(NumNode))
End If
IF (Contaminant%GenericContamSimulation) Then
CALL SetupOutputVariable('System Node Generic Air Contaminant Concentration [ppm]', Node(NumNode)%GenContam,'System', &
'Average',NodeID(NumNode))
End If
ENDDO
ENDIF
NodeVarsSetup=.true.
WRITE(OutputFileBNDetails,701) '! This file shows details about the branches, nodes, and other'
WRITE(OutputFileBNDetails,701) '! elements of the flow connections.'
WRITE(OutputFileBNDetails,701) '! This file is intended for use in "debugging" potential problems'
WRITE(OutputFileBNDetails,701) '! that may also be detected by the program, but may be more easily'
WRITE(OutputFileBNDetails,701) '! identified by "eye".'
WRITE(OutputFileBNDetails,701) '! This file is also intended to support software which draws a'
WRITE(OutputFileBNDetails,701) '! schematic diagram of the HVAC system.'
WRITE(OutputFileBNDetails,701) '! ==============================================================='
! Show the node names on the Branch-Node Details file
WRITE(OutputFileBNDetails,700)
WRITE(ChrOut,*) NumOfUniqueNodeNames
WRITE(OutputFileBNDetails,701) ' #Nodes,'//ADJUSTL(ChrOut)
IF (NumOfUniqueNodeNames > 0) THEN
WRITE(OutputFileBNDetails,702)
ENDIF
Count0=0
DO NumNode = 1, NumOfUniqueNodeNames
WRITE(ChrOut,*) NumNode
ChrOut=ADJUSTL(ChrOut)
WRITE(ChrOut1,*) NodeRef(NumNode)
ChrOut1=ADJUSTL(ChrOut1)
ChrOut2=ValidNodeFluidTypes(Node(NumNode)%FluidType)
WRITE(OutputFileBNDetails,701) ' Node,'//TRIM(ChrOut)//','//TRIM(NodeID(NumNode))//','// &
TRIM(ChrOut2)//','//TRIM(ChrOut1)
IF (NodeRef(NumNode) == 0) Count0=Count0+1
ENDDO
! Show suspicious node names on the Branch-Node Details file
IF (Count0 > 0) THEN
WRITE(OutputFileBNDetails,701) '! ==============================================================='
WRITE(OutputFileBNDetails,701) '! Suspicious nodes have 0 references. It is normal for some nodes, however.'
WRITE(OutputFileBNDetails,701) '! Listing nodes with 0 references (culled from previous list):'
WRITE(OutputFileBNDetails,703)
DO NumNode = 1, NumOfUniqueNodeNames
IF (NodeRef(NumNode) > 0) CYCLE
WRITE(ChrOut,*) NumNode
ChrOut=ADJUSTL(ChrOut)
WRITE(ChrOut1,*) NodeRef(NumNode)
ChrOut1=ADJUSTL(ChrOut1)
ChrOut2=ValidNodeFluidTypes(Node(NumNode)%FluidType)
WRITE(OutputFileBNDetails,701) ' Suspicious Node,'//TRIM(ChrOut)//','//TRIM(NodeID(NumNode))//','// &
TRIM(ChrOut2)//','//TRIM(ChrOut1)
ENDDO
ENDIF
ENDIF
700 FORMAT('! #Nodes,<Number of Unique Nodes>')
701 FORMAT(A)
702 FORMAT('! <Node>,<NodeNumber>,<Node Name>,<Node Fluid Type>,<# Times Node Referenced After Definition>')
703 FORMAT('! <Suspicious Node>,<NodeNumber>,<Node Name>,<Node Fluid Type>,<# Times Node Referenced After Definition>')
RETURN
END SUBROUTINE SetupNodeVarsForReporting