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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrFound |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE TestAirPathIntegrity(ErrFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine tests supply, return and overall air path integrity.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataGlobals, ONLY: MaxNameLength, OutputFileBNDetails
USE DataInterfaces, ONLY: ShowFatalError, ShowWarningError, ShowSevereError, ShowMessage, ShowContinueError
USE DataLoopNode
USE DataHVACGlobals, ONLY: NumPrimaryAirSys
USE DataAirLoop, ONLY: AirToZoneNodeInfo
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrFound
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
INTERFACE
SUBROUTINE TestReturnAirPathIntegrity(ErrFound,ValRetAPaths)
LOGICAL(KIND=4), INTENT(INOUT) :: ErrFound
INTEGER(KIND=4) :: ValRetAPaths(:,:)
END SUBROUTINE TestReturnAirPathIntegrity
END INTERFACE
!COMPILER-GENERATED INTERFACE MODULE: Thu Sep 29 07:54:46 2011
INTERFACE
SUBROUTINE TestSupplyAirPathIntegrity(ErrFound)
LOGICAL(KIND=4), INTENT(INOUT) :: ErrFound
END SUBROUTINE TestSupplyAirPathIntegrity
END INTERFACE
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Loop
INTEGER :: Loop1
INTEGER :: Loop2
INTEGER :: Loop3
INTEGER :: Count
INTEGER :: TestNode
LOGICAL :: ErrFlag
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ValRetAPaths
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NumRAPNodes
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ValSupAPaths
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NumSAPNodes
ALLOCATE(NumSAPNodes(NumPrimaryAirSys,NumOfNodes))
ALLOCATE(NumRAPNodes(NumPrimaryAirSys,NumOfNodes))
ALLOCATE(ValRetAPaths(NumPrimaryAirSys,NumOfNodes))
ALLOCATE(ValSupAPaths(NumPrimaryAirSys,NumOfNodes))
NumSAPNodes=0
NumRAPNodes=0
ValRetAPaths=0
ValSupAPaths=0
CALL TestSupplyAirPathIntegrity(ErrFlag)
IF (ErrFlag) ErrFound=.true.
CALL TestReturnAirPathIntegrity(ErrFlag,ValRetAPaths)
IF (ErrFlag) ErrFound=.true.
! Final tests, look for duplicate nodes
DO Loop=1,NumPrimaryAirSys
IF (ValRetAPaths(Loop,1) /= 0) CYCLE
IF (AirToZoneNodeInfo(Loop)%NumReturnNodes <= 0) CYCLE
ValRetAPaths(Loop,1)=AirToZoneNodeInfo(Loop)%ZoneEquipReturnNodeNum(1)
ENDDO
DO Loop=1,NumPrimaryAirSys
DO Loop1=1,NumOfNodes
TestNode=ValRetAPaths(Loop,Loop1)
Count=0
DO Loop2=1,NumPrimaryAirSys
DO Loop3=1,NumOfNodes
IF (Loop2 == Loop .and. Loop1 == Loop3) CYCLE ! Don't count test node
IF (ValRetAPaths(Loop2,Loop3) == 0) EXIT
IF (ValRetAPaths(Loop2,Loop3) == TestNode) Count=Count+1
ENDDO
ENDDO
IF (Count > 0) THEN
CALL ShowSevereError('Duplicate Node detected in Return Air Paths')
CALL ShowContinueError('Test Node='//TRIM(NodeID(TestNode)))
CALL ShowContinueError('In Air Path='//TRIM(AirToZoneNodeInfo(Loop)%AirLoopName))
ErrFound=.true.
ENDIF
ENDDO
ENDDO
DEALLOCATE(NumSAPNodes)
DEALLOCATE(NumRAPNodes)
DEALLOCATE(ValRetAPaths)
DEALLOCATE(ValSupAPaths)
RETURN
END SUBROUTINE TestAirPathIntegrity