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.
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 GetPVTcollectorsInput
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN June 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Get input for PVT objects
! METHODOLOGY EMPLOYED:
! usual E+ methods
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem , FindItemInList, SameString, &
VerifyName
USE DataIPShortCuts
USE DataHeatBalance
USE DataLoopNode
USE DataEnvironment, ONLY: StdRhoAir
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE ScheduleManager, ONLY: GetScheduleIndex
USE DataInterfaces, ONLY: SetupOutputVariable
USE DataSizing , ONLY: Autosize
USE General, ONLY: RoundSigDigits
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
USE DataPlant !DSU
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Item ! Item to be "gotten"
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
INTEGER :: SurfNum ! local use only
TYPE (SimplePVTModelStruct), ALLOCATABLE, DIMENSION(:) :: tmpSimplePVTperf
INTEGER :: ThisParamObj !
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
! first load the performance object info into temporary structure
cCurrentModuleObject = 'SolarCollectorPerformance:PhotovoltaicThermal:Simple'
NumSimplePVTPerform = GetNumObjectsFound(cCurrentModuleObject)
IF (NumSimplePVTPerform > 0) Then
Allocate(tmpSimplePVTperf(NumSimplePVTPerform))
DO Item=1, NumSimplePVTPerform
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNumbers,IOStatus, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),tmpSimplePVTperf%Name,Item-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Names')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) THEN
CALL ShowSevereError('Invalid '//TRIM(cCurrentModuleObject)//', Name cannot be blank')
ENDIF
CYCLE
ENDIF
tmpSimplePVTperf(Item)%Name = TRIM(cAlphaArgs(1))
If (SameString(cAlphaArgs(2), 'Fixed')) Then
tmpSimplePVTperf(Item)%ThermEfficMode = FixedThermEffic
ELSEIF (SameString(cAlphaArgs(2), 'Scheduled')) Then
tmpSimplePVTperf(Item)%ThermEfficMode = ScheduledThermEffic
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
ErrorsFound=.true.
ENDIF
tmpSimplePVTperf(Item)%ThermalActiveFract = rNumericArgs(1)
tmpSimplePVTperf(Item)%ThermEffic = rNumericArgs(2)
tmpSimplePVTperf(Item)%ThermEffSchedNum = GetScheduleIndex(cAlphaArgs(3))
IF ( (tmpSimplePVTperf(Item)%ThermEffSchedNum == 0) &
.AND. (tmpSimplePVTperf(Item)%ThermEfficMode == ScheduledThermEffic) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
ErrorsFound=.true.
ENDIF
tmpSimplePVTperf(Item)%SurfEmissivity = rNumericArgs(3)
ENDDO
ENDIF !NumSimplePVTPerform > 0
! now get main PVT objects
cCurrentModuleObject = 'SolarCollector:FlatPlate:PhotovoltaicThermal'
NumPVT = GetNumObjectsFound(cCurrentModuleObject)
ALLOCATE(PVT(NumPVT))
ALLOCATE(CheckEquipName(NumPVT))
CheckEquipName=.true.
DO Item=1, NumPVT
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNumbers,IOStatus, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
!check name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), PVT%Name, Item -1, IsNotOK, IsBlank, &
TRIM(cCurrentModuleObject) )
If (IsNotOK) Then
ErrorsFound = .true.
IF (IsBlank) THEN
CALL ShowSevereError('Invalid '//TRIM(cCurrentModuleObject)//', Name cannot be blank')
ENDIF
CYCLE
ENDIF
PVT(Item)%Name = cAlphaArgs(1)
PVT(Item)%TypeNum = TypeOf_PVTSolarCollectorFlatPlate !DSU, assigned in DataPlant
PVT(Item)%SurfNum = FindItemInList(cAlphaArgs(2),Surface%Name,TotSurfaces)
! check surface
IF (PVT(Item)%SurfNum == 0) THEN
IF (lAlphaFieldBlanks(2)) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Surface name cannot be blank.')
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Surface was not found.')
ENDIF
ErrorsFound=.true.
ELSE
! ! Found one -- make sure has right parameters for PVT
SurfNum = PVT(Item)%SurfNum
IF (.NOT. Surface(PVT(Item)%SurfNum)%ExtSolar) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Surface must be exposed to solar.' )
ErrorsFound=.true.
END IF
! check surface orientation, warn if upside down
IF (( Surface(SurfNum)%Tilt < -95.0D0 ) .OR. (Surface(SurfNum)%Tilt > 95.0D0)) THEN
CALL ShowWarningError('Suspected input problem with '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError( 'Surface used for solar collector faces down')
CALL ShowContinueError('Surface tilt angle (degrees from ground outward normal) = ' &
//TRIM(RoundSigDigits(Surface(SurfNum)%Tilt,2) ) )
ENDIF
ENDIF ! check surface
If (lAlphaFieldBlanks(3)) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError(TRIM(cAlphaFieldNames(3))//', name cannot be blank.')
ErrorsFound=.true.
ELSE
PVT(Item)%PVTModelName = cAlphaArgs(3)
ThisParamObj = FindItemInList( PVT(Item)%PVTModelName, tmpSimplePVTperf%Name, NumSimplePVTPerform)
IF (ThisParamObj > 0) THEN
PVT(Item)%Simple = tmpSimplePVTperf(ThisParamObj) ! entire structure assigned
! do one-time setups on input data
PVT(Item)%AreaCol = Surface(PVT(Item)%SurfNum)%Area * PVT(Item)%Simple%ThermalActiveFract
PVT(Item)%PVTModelType = SimplePVTmodel
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//' = '//TRIM(cAlphaArgs(3)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError(TRIM(cAlphaFieldNames(3))//', was not found.')
ErrorsFound=.true.
ENDIF
ENDIF
!
IF (ALLOCATED(PVarray)) THEN ! then PV input gotten... but don't expect this to be true.
PVT(Item)%PVnum = FindItemInList( cAlphaArgs(4) ,PVarray%name, NumPVs)
! check PV
IF (PVT(Item)%PVnum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(cAlphaArgs(4)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
ErrorsFound=.true.
ELSE
PVT(Item)%PVname = TRIM(cAlphaArgs(4))
PVT(Item)%PVfound = .TRUE.
endif
ELSE ! no PV or not yet gotten.
PVT(Item)%PVname = TRIM(cAlphaArgs(4))
PVT(Item)%PVfound = .FALSE.
ENDIF
IF (SameString(cAlphaArgs(5), 'Water' )) THEN
PVT(Item)%WorkingFluidType = LiquidWorkingFluid
ELSEIF (SameString (cAlphaArgs(5), 'Air' )) THEN
PVT(Item)%WorkingFluidType = AirWorkingFluid
ELSE
IF (lAlphaFieldBlanks(5)) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(5))//' = '//TRIM(cAlphaArgs(5)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError(TRIM(cAlphaFieldNames(5))//' field cannot be blank.')
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(5))//' = '//TRIM(cAlphaArgs(5)) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) )
ENDIF
ErrorsFound=.true.
ENDIF
IF (PVT(Item)%WorkingFluidType == LiquidWorkingFluid) THEN
PVT(Item)%PlantInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet,1,ObjectIsNotParent )
PVT(Item)%PlantOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet,1,ObjectIsNotParent )
CALL TestCompSet(TRIM(cCurrentModuleObject), cAlphaArgs(1), cAlphaArgs(6), cAlphaArgs(7), 'Water Nodes')
PVT(Item)%WLoopSideNum = DemandSupply_No
ENDIF
IF (PVT(Item)%WorkingFluidType == AirWorkingFluid) THEN
PVT(Item)%HVACInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(8), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
PVT(Item)%HVACOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(9), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL TestCompSet( TRIM(cCurrentModuleObject), cAlphaArgs(1), cAlphaArgs(8), cAlphaArgs(9), 'Air Nodes' )
ENDIF
PVT(Item)%DesignVolFlowRate = rNumericArgs(1)
PVT(Item)%SizingInit = .TRUE.
IF (PVT(Item)%DesignVolFlowRate /= Autosize) THEN
IF (PVT(Item)%WorkingFluidType == LiquidWorkingFluid) Then
CALL RegisterPlantCompDesignFlow( PVT(Item)%PlantInletNodeNum, PVT(Item)%DesignVolFlowRate )
ELSEIF(PVT(Item)%WorkingFluidType == AirWorkingFluid) Then
PVT(Item)%MaxMassFlowRate = PVT(Item)%DesignVolFlowRate * StdRhoAir
ENDIF
PVT(Item)%SizingInit = .FALSE.
ENDIF
ENDDO
DO Item=1, NumPVT
! electrical production reporting under generator:photovoltaic....
! only thermal side reported here,
CALL SetupOutputVariable('Generator Produced Thermal Rate [W]', &
PVT(Item)%Report%ThermPower, 'System', 'Average', PVT(Item)%name )
IF (PVT(Item)%WorkingFluidType == LiquidWorkingFluid) THEN
CALL SetupOutputVariable('Generator Produced Thermal Energy [J]', &
PVT(Item)%Report%ThermEnergy, 'System', 'Sum', PVT(Item)%name , &
ResourceTypeKey='SolarWater', EndUseKey='HeatProduced', GroupKey='Plant')
ELSEIF (PVT(Item)%WorkingFluidType == AirWorkingFluid) THEN
CALL SetupOutputVariable('Generator Produced Thermal Energy [J]', &
PVT(Item)%Report%ThermEnergy, 'System', 'Sum', PVT(Item)%name , &
ResourceTypeKey='SolarAir', EndUseKey='HeatProduced', GroupKey='System')
CALL SetupOutputVariable('Generator PVT Fluid Bypass Status []', &
PVT(Item)%Report%BypassStatus, 'System', 'Average', PVT(Item)%name )
ENDIF
CALL SetupOutputVariable('Generator PVT Fluid Inlet Temperature [C]', &
PVT(Item)%Report%TinletWorkFluid, 'System', 'Average', PVT(Item)%name )
CALL SetupOutputVariable('Generator PVT Fluid Outlet Temperature [C]', &
PVT(Item)%Report%ToutletWorkFluid, 'System', 'Average', PVT(Item)%name )
CALL SetupOutputVariable('Generator PVT Fluid Mass Flow Rate [kg/s]', &
PVT(Item)%Report%MdotWorkFluid, 'System', 'Average', PVT(Item)%name )
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for photovoltaic thermal collectors')
ENDIF
IF (ALLOCATED(tmpSimplePVTperf)) DEALLOCATE(tmpSimplePVTperf)
RETURN
END SUBROUTINE GetPVTcollectorsInput