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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | EquipName | |||
integer, | intent(inout) | :: | CompIndex | |||
integer, | intent(in) | :: | AirLoopNum | |||
logical, | intent(inout) | :: | HeatingActive | |||
logical, | intent(inout) | :: | CoolingActive |
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 SimCoilUserDefined(EquipName, CompIndex, AirLoopNum, HeatingActive, CoolingActive)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN Feb. 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
USE General, ONLY: TrimSigDigits
USE EMSManager, ONLY: ManageEMS
USE PlantUtilities, ONLY: SetComponentFlowRate, InitComponentNodes, RegisterPlantCompDesignFlow
USE Psychrometrics, ONLY: PsyHFnTdbW
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: EquipName ! user name for component
INTEGER, INTENT(INOUT) :: CompIndex
INTEGER, INTENT(IN) :: AirLoopNum
LOGICAL, INTENT(INOUT) :: HeatingActive
LOGICAL, INTENT(INOUT) :: CoolingActive
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: EnthInlet
REAL(r64) :: EnthOutlet
INTEGER :: CompNum
IF (GetInput) THEN
CALL GetUserDefinedComponents
GetInput=.FALSE.
END IF
! Find the correct Equipment
IF (CompIndex == 0) THEN
CompNum = FindItemInList(EquipName, UserCoil%Name, NumUserCoils)
IF (CompNum == 0) THEN
CALL ShowFatalError('SimUserDefinedPlantComponent: User Defined Coil not found')
ENDIF
CompIndex = CompNum
ELSE
CompNum = CompIndex
IF (CompNum < 1 .OR. CompNum > NumUserCoils) THEN
CALL ShowFatalError('SimUserDefinedPlantComponent: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(CompNum))// &
', Number of units ='//TRIM(TrimSigDigits(NumUserCoils))// &
', Entered Unit name = '//TRIM(EquipName) )
ENDIF
IF(CheckUserCoilName(CompNum)) THEN
IF (EquipName /= UserCoil(CompNum)%Name) THEN
CALL ShowFatalError('SimUserDefinedPlantComponent: Invalid CompIndex passed='// &
TRIM(TrimSigDigits(CompNum))// &
', Unit name='//TRIM(EquipName)//', stored unit name for that index='// &
TRIM(UserCoil(CompNum)%Name) )
ENDIF
CheckUserCoilName(CompNum) = .FALSE.
ENDIF
ENDIF
IF (BeginEnvrnFlag) THEN
IF (UserCoil(CompNum)%ErlInitProgramMngr > 0) THEN
CALL ManageEMS(emsCallFromUserDefinedComponentModel, &
ProgramManagerToRun = UserCoil(CompNum)%ErlInitProgramMngr )
ENDIF
IF (UserCoil(CompNum)%PlantIsConnected) THEN
CALL InitComponentNodes(UserCoil(CompNum)%Loop%MassFlowRateMin, &
UserCoil(CompNum)%Loop%MassFlowRateMax, &
UserCoil(CompNum)%Loop%InletNodeNum, &
UserCoil(CompNum)%Loop%OutletNodeNum, &
UserCoil(CompNum)%Loop%LoopNum, &
UserCoil(CompNum)%Loop%LoopSideNum, &
UserCoil(CompNum)%Loop%BranchNum, &
UserCoil(CompNum)%Loop%CompNum )
CALL RegisterPlantCompDesignFlow(UserCoil(CompNum)%Loop%InletNodeNum, &
UserCoil(CompNum)%Loop%DesignVolumeFlowRate)
ENDIF
ENDIF
CALL InitCoilUserDefined(CompNum)
IF (UserCoil(CompNum)%ErlSimProgramMngr > 0) THEN
CALL ManageEMS(emsCallFromUserDefinedComponentModel, &
ProgramManagerToRun = UserCoil(CompNum)%ErlSimProgramMngr)
ENDIF
CALL ReportCoilUserDefined(CompNum)
IF (AirLoopNum /=-1) THEN ! IF the sysem is not an equipment of outdoor air unit
! determine if heating or cooling on primary air stream
IF (Node(UserCoil(CompNum)%Air(1)%InletNodeNum)%Temp < Node(UserCoil(CompNum)%Air(1)%InletNodeNum)%Temp ) THEN
HeatingActive = .TRUE.
ELSE
HeatingActive = .FALSE.
ENDIF
EnthInlet = PSyHFnTdbW(Node(UserCoil(CompNum)%Air(1)%InletNodeNum)%Temp, Node(UserCoil(CompNum)%Air(1)%InletNodeNum)%HumRat)
EnthOutlet = PSyHFnTdbW(Node(UserCoil(CompNum)%Air(1)%OutletNodeNum)%Temp, Node(UserCoil(CompNum)%Air(1)%OutletNodeNum)%HumRat)
IF (EnthInlet > EnthOutlet) THEN
CoolingActive = .TRUE.
ELSE
CoolingActive = .FALSE.
ENDIF
ENDIF
RETURN
END SUBROUTINE SimCoilUserDefined