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 GetWatertoWaterHPInput
! SUBROUTINE INFORMATION:
! AUTHOR Kenneth Tang
! DATE WRITTEN March 2005
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtain input from IDF and store them in data structures
! METHODOLOGY EMPLOYED:
! REFERENCES:
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName
USE NodeInputManager, ONLY : GetOnlySingleNode
USE BranchNodeConnections, ONLY : TestCompSet
USE PlantUtilities, ONLY : RegisterPlantCompDesignFlow
USE DataPlant, ONLY: TypeOf_HPWaterEFCooling, TypeOf_HPWaterEFHeating,ScanPlantLoopsForObject
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 number
INTEGER :: HPNum ! Counter
INTEGER :: NumCoolCoil ! Number of Cooling Coils
INTEGER :: NumHeatCoil ! Number of Heating Coils
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(15) :: NumArray ! numeric data
LOGICAL, SAVE :: ErrorsFound = .false.
LOGICAL :: IsNotOk ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errFlag
NumCoolCoil = GetNumObjectsFound(HPEqFitCoolingUC)
NumHeatCoil = GetNumObjectsFound(HPEqFitHeatingUC)
NumGSHPs = NumCoolCoil + NumHeatCoil
IF(NumGSHPs <= 0) THEN
CALL ShowSevereError('GetEquationFitWaterToWater Input: No Equipment found')
ErrorsFound=.true.
END IF
IF(NumGSHPs > 0) THEN
ALLOCATE (GSHP(NumGSHPs))
ALLOCATE (GSHPReport(NumGSHPs))
! initialize the data structures
END IF
!Load data structure for cooling coil
DO HPNum = 1, NumCoolCoil
GSHPNum = HPNum
CALL GetObjectItem(HPEqFitCoolingUC,HPNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT)
IsNotOk=.false.
IsBlank=.true.
CALL VerifyName(AlphArray(1),GSHP%Name,HPNum-1, ISNotOK,ISBlank,'GHSP Name')
IF (ISNotOK) THEN
ErrorsFound=.true.
IF(ISBlank) AlphArray(1)='xxxxx'
END IF
GSHP(GSHPNum)%WWHPPlantTypeOfNum = TypeOf_HPWaterEFCooling
GSHP(GSHPNum)%Name = AlphArray(1)
GSHP(GSHPNum)%RatedLoadVolFlowCool = NumArray(1)
GSHP(GSHPNum)%RatedSourceVolFlowCool= NumArray(2)
GSHP(GSHPNum)%RatedCapCool = NumArray(3)
GSHP(GSHPNum)%RatedPowerCool = NumArray(4)
GSHP(GSHPNum)%CoolCap1 = NumArray(5)
GSHP(GSHPNum)%CoolCap2 = NumArray(6)
GSHP(GSHPNum)%CoolCap3 = NumArray(7)
GSHP(GSHPNum)%CoolCap4 = NumArray(8)
GSHP(GSHPNum)%CoolCap5 = NumArray(9)
GSHP(GSHPNum)%CoolPower1 = NumArray(10)
GSHP(GSHPNum)%CoolPower2 = NumArray(11)
GSHP(GSHPNum)%CoolPower3 = NumArray(12)
GSHP(GSHPNum)%CoolPower4 = NumArray(13)
GSHP(GSHPNum)%CoolPower5 = NumArray(14)
GSHP(GSHPNum)%SourceSideInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,HPEqFitCoolingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
GSHP(GSHPNum)%SourceSideOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,HPEqFitCoolingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
GSHP(GSHPNum)%LoadSideInletNodeNum = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,HPEqFitCoolingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
GSHP(GSHPNum)%LoadSideOutletNodeNum = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,HPEqFitCoolingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
! Test node sets
CALL TestCompSet(HPEqFitCoolingUC,AlphArray(1),AlphArray(2),AlphArray(3),'Condenser Water Nodes')
CALL TestCompSet(HPEqFitCoolingUC,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)%RatedSourceVolFlowCool)
! CurrentModuleObject='HeatPump:WatertoWater:EquationFit:Cooling'
CALL SetupOutputVariable('Water to Water Heat Pump Electric Energy [J]', &
GSHPReport(GSHPNum)%Energy,'System','Sum',GSHP(GSHPNum)%Name, &
ResourceTypeKey='Electricity',EndUseKey='Cooling',GroupKey='Plant')
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 Energy [J]', &
GSHPReport(GSHPNum)%QSourceEnergy,'System','Sum',GSHP(GSHPNum)%Name)
END DO
!Load data structure for heating coil
DO HPNum = 1, NumHeatCoil
GSHPNum = NumCoolCoil + HPNum
CALL GetObjectItem(HPEqFitHeatingUC,HPNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT)
IsNotOk=.false.
IsBlank=.true.
CALL VerifyName(AlphArray(1),GSHP%Name,HPNum-1, ISNotOK,ISBlank,'GHSP Name')
IF (ISNotOK) THEN
ErrorsFound=.true.
IF(ISBlank) AlphArray(1)='xxxxx'
END IF
GSHP(GSHPNum)%WWHPPlantTypeOfNum = TypeOf_HPWaterEFHeating
GSHP(GSHPNum)%Name = AlphArray(1)
GSHP(GSHPNum)%RatedLoadVolFlowHeat = NumArray(1)
GSHP(GSHPNum)%RatedSourceVolFlowHeat= NumArray(2)
GSHP(GSHPNum)%RatedCapHeat = NumArray(3)
GSHP(GSHPNum)%RatedPowerHeat = NumArray(4)
GSHP(GSHPNum)%HeatCap1 = NumArray(5)
GSHP(GSHPNum)%HeatCap2 = NumArray(6)
GSHP(GSHPNum)%HeatCap3 = NumArray(7)
GSHP(GSHPNum)%HeatCap4 = NumArray(8)
GSHP(GSHPNum)%HeatCap5 = NumArray(9)
GSHP(GSHPNum)%HeatPower1 = NumArray(10)
GSHP(GSHPNum)%HeatPower2 = NumArray(11)
GSHP(GSHPNum)%HeatPower3 = NumArray(12)
GSHP(GSHPNum)%HeatPower4 = NumArray(13)
GSHP(GSHPNum)%HeatPower5 = NumArray(14)
GSHP(GSHPNum)%SourceSideInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,HPEqFitHeatingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
GSHP(GSHPNum)%SourceSideOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,HPEqFitHeatingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
GSHP(GSHPNum)%LoadSideInletNodeNum = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,HPEqFitHeatingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
GSHP(GSHPNum)%LoadSideOutletNodeNum = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,HPEqFitHeatingUC,AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
! Test node sets
CALL TestCompSet(HPEqFitHeatingUC,AlphArray(1),AlphArray(2),AlphArray(3),'Condenser Water Nodes')
CALL TestCompSet(HPEqFitHeatingUC,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)%RatedSourceVolFlowHeat)
! CurrentModuleObject='HeatPump:WatertoWater:EquationFit:Heating'
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 Energy [J]', &
GSHPReport(GSHPNum)%QLoadEnergy,'System','Sum',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Heat Transfer Energy [J]', &
GSHPReport(GSHPNum)%QSourceEnergy,'System','Sum',GSHP(GSHPNum)%Name)
END DO
DO GSHPNum = 1,NumGSHPs
!setup output variables
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 Load Side Heat Transfer Rate [W]', &
GSHPReport(GSHPNum)%QLoad,'System','Average',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 Load Side Outlet Temperature [C]', &
GSHPReport(GSHPNum)%LoadSideOutletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Load Side Inlet Temperature [C]', &
GSHPReport(GSHPNum)%LoadSideInletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Outlet Temperature [C]', &
GSHPReport(GSHPNum)%SourceSideOutletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Inlet Temperature [C]', &
GSHPReport(GSHPNum)%SourceSideInletTemp,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Load Side Mass Flow Rate [kg/s]', &
GSHPReport(GSHPNum)%LoadSideMassFlowRate,'System','Average',GSHP(GSHPNum)%Name)
CALL SetupOutputVariable('Water to Water Heat Pump Source Side Mass Flow Rate [kg/s]', &
GSHPReport(GSHPNum)%SourceSideMassFlowRate,'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 GetWatertoWaterHPInput