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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | CompNum |
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 InitCoilUserDefined(CompNum)
! SUBROUTINE INFORMATION:
! AUTHOR <author>
! DATE WRITTEN <date_written>
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW, PsyCpAirFnWTdb
USE DataEnvironment, ONLY: OutBaroPress
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CompNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyFlag
LOGICAL :: errFlag
INTEGER :: Loop
IF (MyOneTimeFlag) THEN
ALLOCATE(MyFlag(NumUserCoils))
MyFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF (MyFlag(CompNum)) THEN
IF (UserCoil(CompNum)%PlantIsConnected) THEN
errFlag = .false.
CALL ScanPlantLoopsForObject(UserCoil(CompNum)%Name, &
Typeof_CoilUserDefined, &
UserCoil(CompNum)%Loop%LoopNum, &
UserCoil(CompNum)%Loop%LoopSideNum, &
UserCoil(CompNum)%Loop%BranchNum, &
UserCoil(CompNum)%Loop%CompNum )
IF (errFlag) THEN
CALL ShowFatalError('InitPlantUserComponent: Program terminated due to previous condition(s).')
ENDIF
!set user input for flow priority
PlantLoop(UserCoil(CompNum)%Loop%LoopNum)% &
LoopSide(UserCoil(CompNum)%Loop%LoopSideNum)% &
Branch(UserCoil(CompNum)%Loop%BranchNum)% &
Comp(UserCoil(CompNum)%Loop%CompNum)%FlowPriority &
= UserCoil(CompNum)%Loop%FlowPriority
! set user input for how loads served
PlantLoop(UserCoil(CompNum)%Loop%LoopNum)% &
LoopSide(UserCoil(CompNum)%Loop%LoopSideNum)% &
Branch(UserCoil(CompNum)%Loop%BranchNum)% &
Comp(UserCoil(CompNum)%Loop%CompNum)%HowLoadServed &
= UserCoil(CompNum)%Loop%HowLoadServed
ENDIF
MyFlag(CompNum) = .FALSE.
ENDIF
! fill internal variable targets
DO loop = 1, UserCoil(CompNum)%NumAirConnections
UserCoil(CompNum)%Air(loop)%InletRho = PsyRhoAirFnPbTdbW(OutBaroPress, &
Node(UserCoil(CompNum)%Air(loop)%InletNodeNum)%Temp, &
Node(UserCoil(CompNum)%Air(loop)%InletNodeNum)%HumRat, &
'InitCoilUserDefined')
UserCoil(CompNum)%Air(loop)%InletCp = PsyCpAirFnWTdb( &
Node(UserCoil(CompNum)%Air(loop)%InletNodeNum)%HumRat, &
Node(UserCoil(CompNum)%Air(loop)%InletNodeNum)%Temp , &
'InitCoilUserDefined')
UserCoil(CompNum)%Air(loop)%InletTemp = &
Node(UserCoil(CompNum)%Air(loop)%InletNodeNum)%Temp
UserCoil(CompNum)%Air(loop)%InletMassFlowRate = &
Node(UserCoil(CompNum)%Air(loop)%InletNodeNum)%MassFlowRate
UserCoil(CompNum)%Air(loop)%InletHumRat = &
Node(UserCoil(CompNum)%Air(loop)%InletNodeNum)%HumRat
ENDDO
IF (UserCoil(CompNum)%PlantIsConnected) THEN
UserCoil(CompNum)%Loop%InletRho = GetDensityGlycol( &
PlantLoop(UserCoil(CompNum)%Loop%LoopNum)%FluidName, &
Node(UserCoil(CompNum)%Loop%InletNodeNum)%Temp, &
PlantLoop(UserCoil(CompNum)%Loop%LoopNum)%FluidIndex, &
'InitCoilUserDefined')
UserCoil(CompNum)%Loop%InletCp = GetSpecificHeatGlycol( &
PlantLoop(UserCoil(CompNum)%Loop%LoopNum)%FluidName, &
Node(UserCoil(CompNum)%Loop%InletNodeNum)%Temp, &
PlantLoop(UserCoil(CompNum)%Loop%LoopNum)%FluidIndex, &
'InitCoilUserDefined')
UserCoil(CompNum)%Loop%InletTemp = &
Node(UserCoil(CompNum)%Loop%InletNodeNum)%Temp
UserCoil(CompNum)%Loop%InletMassFlowRate = &
Node(UserCoil(CompNum)%Loop%InletNodeNum)%MassFlowRate
ENDIF
RETURN
END SUBROUTINE InitCoilUserDefined