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) | :: | PVTnum | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 InitPVTcollectors(PVTnum, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN June 2008
! MODIFIED B. Griffith, May 2009, EMS setpoint check
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! init for PVT
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: SysSizingCalc, InitConvTemp, AnyEnergyManagementSystemInModel
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE DataLoopNode, ONLY: Node, SensedNodeFlagValue
USE FluidProperties, ONLY: GetDensityGlycol
USE InputProcessor, ONLY: FindItemInList
USE DataHVACGlobals, ONLY: DoSetPointTest, SetPointErrorFlag
USE DataHeatBalance, ONLY: QRadSWOutIncident
USE General, ONLY: RoundSigDigits
USE EMSManager, ONLY: iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
USE DataPlant, ONLY: ScanPlantLoopsForObject, PlantLoop
USE PlantUtilities, ONLY: SetComponentFlowRate , InitComponentNodes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: PVTnum
LOGICAL, INTENT(IN) :: FirstHVACIteration
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode
INTEGER :: OutletNode
INTEGER :: PVTindex
INTEGER :: SurfNum
LOGICAL :: ErrorsFound = .FALSE.
LOGICAL,SAVE :: MySetPointCheckFlag = .TRUE.
LOGICAL, SAVE :: MyOneTimeFlag = .TRUE. ! one time flag
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: SetLoopIndexFlag ! get loop number flag
LOGICAL :: errFlag
REAL(r64) :: rho ! local fluid density kg/s
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(SetLoopIndexFlag(NumPVT))
SetLoopIndexFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
IF(SetLoopIndexFlag(PVTnum))THEN
IF(ALLOCATED(PlantLoop) .AND. (PVT(PVTnum)%PlantInletNodeNum >0 ) )THEN
errFlag=.false.
CALL ScanPlantLoopsForObject(PVT(PVTnum)%Name, &
PVT(PVTnum)%TypeNum, &
PVT(PVTnum)%WLoopNum, &
PVT(PVTnum)%WLoopSideNum, &
PVT(PVTnum)%WLoopBranchNum, &
PVT(PVTnum)%WLoopCompNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitPVTcollectors: Program terminated for previous conditions.')
ENDIF
SetLoopIndexFlag(PVTnum) = .FALSE.
ENDIF
ENDIF
! finish set up of PV, becaues PV get-input follows PVT's get input.
IF (.NOT. PVT(PVTnum)%PVfound) Then
IF (ALLOCATED(PVarray)) THEN
PVT(PVTnum)%PVnum = FindItemInList( PVT(PVTnum)%PVname ,PVarray%name, NumPVs)
IF (PVT(PVTnum)%PVnum == 0) THEN
CALL ShowSevereError('Invalid name for photovoltaic generator = '//TRIM(PVT(PVTnum)%PVname) )
CALL ShowContinueError('Entered in flat plate photovoltaic-thermal collector = '//TRIM(PVT(PVTnum)%Name) )
ErrorsFound=.TRUE.
ELSE
PVT(PVTnum)%PVfound = .TRUE.
ENDIF
ELSE
IF ((.NOT. BeginEnvrnFlag) .AND. (.NOT. FirstHVACIteration)) THEN
CALL ShowSevereError('Photovoltaic generators are missing for Photovoltaic Thermal modeling' )
CALL ShowContinueError('Needed for flat plate photovoltaic-thermal collector = '//TRIM(PVT(PVTnum)%Name) )
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySetPointCheckFlag .AND. DoSetPointTest) THEN
DO PVTindex = 1, NumPVT
IF (PVT(PVTindex)%WorkingFluidType == AirWorkingFluid) THEN
IF (Node(PVT(PVTindex)%HVACOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError( 'Missing temperature setpoint for PVT outlet node ')
CALL ShowContinueError('Add a setpoint manager to outlet node of PVT named ' &
//Trim(PVT(PVTindex)%Name) )
SetPointErrorFlag = .TRUE.
ELSE
! need call to EMS to check node
CALL CheckIfNodeSetpointManagedByEMS(PVT(PVTindex)%HVACOutletNodeNum,iTemperatureSetpoint, SetPointErrorFlag)
IF (SetPointErrorFlag) THEN
CALL ShowSevereError( 'Missing temperature setpoint for PVT outlet node ')
CALL ShowContinueError('Add a setpoint manager to outlet node of PVT named ' &
//Trim(PVT(PVTindex)%Name) )
CALL ShowContinueError(' or use an EMS actuator to establish a setpoint at the outlet node of PVT')
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
MySetPointCheckFlag = .FALSE.
END IF
!Size design flow rate
IF ( .NOT. SysSizingCalc .AND. PVT(PVTnum)%SizingInit) THEN
CALL SizePVT(PVTnum)
ENDIF
SELECT CASE (PVT(PVTnum)%WorkingFluidType)
CASE (LiquidWorkingFluid)
InletNode = PVT(PVTnum)%PlantInletNodeNum
OutletNode = PVT(PVTnum)%PlantOutletNodeNum
CASE (AirWorkingFluid)
InletNode = PVT(PVTnum)%HVACInletNodeNum
OutletNode = PVT(PVTnum)%HVACOutletNodeNum
END SELECT
IF (BeginEnvrnFlag .AND. PVT(PVTnum)%EnvrnInit ) THEN
PVT(PVTnum)%MassFlowRate = 0.d0
PVT(PVTnum)%BypassDamperOff = .TRUE.
PVT(PVTnum)%CoolingUseful = .FALSE.
PVT(PVTnum)%HeatingUseful = .FALSE.
PVT(PVTnum)%Simple%LastCollectorTemp = 0.d0
PVT(PVTnum)%Simple%CollectorTemp = 0.d0
PVT(PVTnum)%Report%ThermEfficiency = 0.d0
PVT(PVTnum)%Report%ThermPower = 0.d0
PVT(PVTnum)%Report%ThermHeatGain = 0.d0
PVT(PVTnum)%Report%ThermHeatLoss = 0.d0
PVT(PVTnum)%Report%ThermEnergy = 0.d0
PVT(PVTnum)%Report%MdotWorkFluid = 0.d0
PVT(PVTnum)%Report%TinletWorkFluid = 0.d0
PVT(PVTnum)%Report%ToutletWorkFluid = 0.d0
PVT(PVTnum)%Report%BypassStatus = 0.d0
SELECT CASE (PVT(PVTnum)% WorkingFluidType)
CASE (LiquidWorkingFluid)
rho = GetDensityGlycol(PlantLoop(PVT(PVTnum)%WLoopNum)%FluidName, &
60.d0, &
PlantLoop(PVT(PVTnum)%WLoopNum)%FluidIndex, &
'InitPVTcollectors')
PVT(PVTnum)%MaxMassFlowRate = PVT(PVTnum)%DesignVolFlowRate * rho
CALL InitComponentNodes(0.d0, PVT(PVTnum)%MaxMassFlowRate, &
InletNode, OutletNode, &
PVT(PVTnum)%WLoopNum, &
PVT(PVTnum)%WLoopSideNum, &
PVT(PVTnum)%WLoopBranchNum, &
PVT(PVTnum)%WLoopCompNum )
PVT(PVTnum)%Simple%LastCollectorTemp = 23.0D0
CASE (AirWorkingFluid)
PVT(PVTnum)%Simple%LastCollectorTemp = 23.0D0
END SELECT
PVT(PVTnum)%EnvrnInit = .FALSE.
ENDIF
IF (.NOT. BeginEnvrnFlag) PVT(PVTnum)%EnvrnInit = .TRUE.
SELECT CASE (PVT(PVTnum)% WorkingFluidType)
CASE (LiquidWorkingFluid)
! heating only right now, so control flow requests based on incident solar
SurfNum = PVT(PVTnum)%SurfNum
IF (QRadSWOutIncident(SurfNum) > MinIrradiance) THEN
!IF (FirstHVACIteration) THEN
PVT(PVTnum)%MassFlowRate = PVT(PVTnum)%MaxMassFlowRate !DSU
!ENDIF
ELSE
!IF (FirstHVACIteration) THEN
PVT(PVTnum)%MassFlowRate = 0.0D0 !DSU
!ENDIF
ENDIF
! Should we declare a mass flow rate variable in the data structure instead of using node(outlet)%massflowrate ? DSU
CALL SetComponentFlowRate( PVT(PVTnum)%MassFlowRate,InletNode,OutletNode, & !DSU
PVT(PVTnum)%WLoopNum,PVT(PVTnum)%WLoopSideNum , &
PVT(PVTnum)%WLoopBranchNum , PVT(PVTnum)%WLoopCompNum) !DSU
CASE (AirWorkingFluid)
PVT(PVTnum)%MassFlowRate = Node(InletNode)%MassFlowRate
END SELECT
RETURN
END SUBROUTINE InitPVTcollectors