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 GetGshpInput
! SUBROUTINE INFORMATION:
! AUTHOR:
! DATE WRITTEN: April 1998
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the GSHP models. As such
! it will interact with the Input Scanner to retrieve
! information from the input file, count the number of
! GSHPs and begin to fill the
! arrays associated with the type GSHP.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! USE STATEMENTS:
USE DataPlant, ONLY: TypeOf_HPWaterPEHeating, ScanPlantLoopsForObject
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName
USE NodeInputManager, ONLY : GetOnlySingleNode
USE BranchNodeConnections, ONLY : TestCompSet
USE FluidProperties, ONLY : FindRefrigerant
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: GshpNum !Gshp counter
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
CHARACTER(len=MaxNameLength),DIMENSION(5) :: AlphArray !character string data
REAL(r64), DIMENSION(23) :: NumArray !numeric data
LOGICAL, SAVE :: ErrorsFound = .false.
LOGICAL :: IsNotOk ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errFlag
NumGshps = GetNumObjectsFound(ModuleCompName)
IF(NumGshps <= 0) THEN
CALL ShowSevereError(ModuleCompName//': No Equipment found')
ErrorsFound=.true.
END IF
! Allocate Arrays
ALLOCATE (GSHP(NumGshps))
ALLOCATE (GshpReport(NumGshps))
ALLOCATE(CheckEquipName(NumGshps))
CheckEquipName=.true.
DO GshpNum = 1, NumGshps
CALL GetObjectItem(ModuleCompNameUC,GshpNum,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT)
IsNotOk=.false.
IsBlank=.true.
CALL VerifyName(AlphArray(1),GSHP%Name,GSHPNum-1, ISNotOK,ISBlank,'GHSP Name')
IF (ISNotOK) THEN
ErrorsFound=.true.
IF(ISBlank) AlphArray(1)='xxxxx'
END IF
GSHP(GSHPNum)%Name = AlphArray(1)
GSHP(GSHPNum)%WWHPPlantTypeOfNum = TypeOf_HPWaterPEHeating
GSHP(GSHPNum)%COP = NumArray(1)
IF(NumArray(1) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':COP = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
! zero values for NumArray 3 - 6 checked in input - idd
GSHP(GSHPNum)%NomCap = NumArray(2)
GSHP(GSHPNum)%MinPartLoadRat = NumArray(3)
GSHP(GSHPNum)%MaxPartLoadRat = NumArray(4)
GSHP(GSHPNum)%OptPartLoadRat = NumArray(5)
GSHP(GSHPNum)%LoadSideVolFlowRate = NumArray(6)
IF(NumArray(6) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Load Side Flow Rate = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%SourceSideVolFlowRate = NumArray(7)
IF(NumArray(7) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Source Side Flow Rate = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%LoadSideUACoeff = NumArray(8)
IF(NumArray(8) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Load Side Heat Transfer Coeffcient = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%SourceSideUACoeff = NumArray(9)
IF(NumArray(9) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Source Side Heat Transfer Coeffcient = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%CompPistonDisp = NumArray(10)
IF(NumArray(10) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Compressor Piston displacement/Storke = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%CompClearanceFactor = NumArray(11)
IF(NumArray(11) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Compressor Clearance Factor = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%CompSucPressDrop = NumArray(12)
IF(NumArray(12)==0.0d0) THEN
CALL ShowSevereError(ModuleCompName//': Pressure Drop = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%SuperheatTemp = NumArray(13)
IF(NumArray(13) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Source Side SuperHeat = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%PowerLosses = NumArray(14)
IF(NumArray(14) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Compressor Power Loss = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%LossFactor = NumArray(15)
IF(NumArray(15) == 0.0d0) THEN
CALL ShowSevereError(ModuleCompName//':Efficiency = 0.0, Heatpump='//TRIM(AlphArray(1)))
ErrorsFound = .true.
END IF
GSHP(GSHPNum)%HighPressCutOff = NumArray(16)
IF(NumArray(16) == 0.0d0) THEN
GSHP(GSHPNum)%HighPressCutOff = 500000000.0d0
!CALL ShowWarningError(ModuleCompName//': High Pressure Cut Off= 0.0 Heat Pump'//TRIM(AlphArray(1)))
END IF
GSHP(GSHPNum)%LowPressCutOff = NumArray(17)
IF(NumArray(17) == 0.0d0) THEN
GSHP(GSHPNum)%LowPressCutOff = 0.0d0
!CALL ShowWarningError(ModuleCompName//': Low Pressure Cut Off= 0.0 Heat Pump'//TRIM(AlphArray(1)))
END IF
GSHP(GSHPNum)%SourceSideInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,ModuleCompName,AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
GSHP(GSHPNum)%SourceSideOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,ModuleCompName,AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
GSHP(GSHPNum)%LoadSideInletNodeNum = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,ModuleCompName,AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
GSHP(GSHPNum)%LoadSideOutletNodeNum = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,ModuleCompName,AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
! Test node sets
CALL TestCompSet(ModuleCompNameUC,AlphArray(1),AlphArray(2),AlphArray(3),'Condenser Water Nodes')
CALL TestCompSet(ModuleCompNameUC,AlphArray(1),AlphArray(4),AlphArray(5),'Hot Water Nodes')
! save the design source side flow rate for use by plant loop sizing algorithms
CALL RegisterPlantCompDesignFlow(GSHP(GSHPNum)%SourceSideInletNodeNum,0.5d0*GSHP(GSHPNum)%SourceSideVolFlowRate)
END DO
IF (ErrorsFound)THEN
CALL ShowFatalError('Errors Found in getting '//ModuleCompNameUC//' Input')
END IF
GSHPRefrigIndex=FindRefrigerant(GSHPRefrigerant)
IF (GSHPRefrigIndex == 0) THEN
CALL ShowFatalError('Refrigerant for HeatPump:WaterToWater Heating not found, should have been='//TRIM(GSHPRefrigerant))
ENDIF
! CurrentModuleObject='HeatPump:WaterToWater:ParameterEstimation:Heating'
DO GSHPNum = 1,NumGshps
CALL SetupOutputVariable('Water to Water Heat Pump Electric Power [W]', &
GshpReport(GSHPNum)%Power,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Electric Energy [J]', &
GshpReport(GSHPNum)%Energy,'System','Sum',GSHP(GSHPNum)%Name, &
ResourceTypeKey='Electricity',EndUseKey='Heating',GroupKey='Plant')
CALL SetupOutputVariable('Water to Water Heat Pump Load Side Heat Transfer Rate [W]', &
GshpReport(GSHPNum)%QLoad,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Load Side Heat Transfer Energy [J]', &
GshpReport(GSHPNum)%QLoadEnergy,'System','Sum',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Heat Transfer Rate [W]', &
GshpReport(GSHPNum)%QSource,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Heat Transfer Energy [J]', &
GshpReport(GSHPNum)%QSourceEnergy,'System','Sum',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Load Side Outlet Temperature [C]', &
GshpReport(GSHPNum)%LoadSideWaterOutletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Load Side Inlet Temperature [C]', &
GshpReport(GSHPNum)%LoadSideWaterInletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Outlet Temperature [C]', &
GshpReport(GSHPNum)%SourceSideWaterOutletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Inlet Temperature [C]', &
GshpReport(GSHPNum)%SourceSideWaterInletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Load Side Mass Flow Rate [kg/s]', &
GshpReport(GSHPNum)%LoadSidemdot,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Mass Flow Rate [kg/s]', &
GshpReport(GSHPNum)%SourceSidemdot,'System','Average',GSHP(GSHPNum)%Name)
!scan for loop connection data
errFlag=.false.
CALL ScanPlantLoopsForObject(GSHP(GSHPNum)%Name, &
GSHP(GSHPNum)%WWHPPlantTypeOfNum, &
GSHP(GSHPNum)%SourceLoopNum, &
GSHP(GSHPNum)%SourceLoopSideNum, &
GSHP(GSHPNum)%SourceBranchNum, &
GSHP(GSHPNum)%SourceCompNum, &
inletNodeNumber = GSHP(GSHPNum)%SourceSideInletNodeNum, &
errflag=errFlag)
CALL ScanPlantLoopsForObject(GSHP(GSHPNum)%Name, &
GSHP(GSHPNum)%WWHPPlantTypeOfNum, &
GSHP(GSHPNum)%LoadLoopNum, &
GSHP(GSHPNum)%LoadLoopSideNum, &
GSHP(GSHPNum)%LoadBranchNum, &
GSHP(GSHPNum)%LoadCompNum, &
inletNodeNumber = GSHP(GSHPNum)%LoadSideInletNodeNum, &
errflag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('GetWatertoWaterHPInput: Program terminated on scan for loop data')
ENDIF
END DO
RETURN
END SUBROUTINE GetGshpInput