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 GetPipesHeatTransfer
! SUBROUTINE INFORMATION:
! AUTHOR Simon Rees
! DATE WRITTEN July 2007
! MODIFIED na
! RE-ENGINEERED na
!
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads the input for hydronic Pipe Heat Transfers
! from the user input file. This will contain all of the information
! needed to define and simulate the surface.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! USE STATEMENTS:
USE DataGlobals, ONLY : NumOfZones,SecInHour,PI
USE DataHeatBalance, ONLY : Construct, TotConstructs, Zone, Material, TotMaterials, &
IntGainTypeOf_PipeIndoor
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, FindItemInList, &
SameString, VerifyName, MakeUPPERCase
USE DataIPShortCuts ! Data for field names, blank numerics
USE NodeInputManager, ONLY : GetOnlySingleNode
USE BranchNodeConnections, ONLY : TestCompSet
USE General, ONLY : RoundSigDigits
USE DataLoopNode
USE ScheduleManager, ONLY: GetScheduleIndex
USE OutAirNodeManager, ONLY: CheckOutAirNodeNumber
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: NumPipeSections = 20
INTEGER, PARAMETER :: NumberOfDepthNodes = 8 ! Number of nodes in the cartesian grid-Should be an even # for now
REAL(r64), PARAMETER :: SecondsInHour = SecInHour
REAL(r64), PARAMETER :: HoursInDay = 24.0d0
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input,
LOGICAL :: IsNotOK=.false.
LOGICAL :: IsBlank=.false.
! fatal at end of routine
INTEGER :: IOStatus ! Used in GetObjectItem
INTEGER :: Item ! Item to be "gotten"
INTEGER :: PipeItem
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: NumFluids ! number of fluids in sim.
INTEGER :: NumOfPipeHTInt ! Number of Pipe Heat Transfer objects
INTEGER :: NumOfPipeHTExt ! Number of Pipe Heat Transfer objects
INTEGER :: NumOfPipeHTUG ! Number of Pipe Heat Transfer objects
INTEGER :: NumSections ! total number of sections in pipe
! Initializations and allocations
cCurrentModuleObject = 'Pipe:Indoor'
NumOfPipeHTInt = GetNumObjectsFound(cCurrentModuleObject)
cCurrentModuleObject = 'Pipe:Outdoor'
NumOfPipeHTExt = GetNumObjectsFound(cCurrentModuleObject)
cCurrentModuleObject = 'Pipe:Underground'
NumOfPipeHTUG = GetNumObjectsFound(cCurrentModuleObject)
NumofPipeHT = NumOfPipeHTInt + NumOfPipeHTExt + NumOfPipeHTUG
! allocate data structures
IF(ALLOCATED(PipeHT)) DEALLOCATE(PipeHT)
IF(ALLOCATED(PipeHTReport)) DEALLOCATE(PipeHTReport)
ALLOCATE(PipeHT(NumOfPipeHT))
ALLOCATE(PipeHTReport(NumOfPipeHT))
! Numbers = 0.0
! Alphas = Blank
Item=0
cCurrentModuleObject = 'Pipe:Indoor'
DO PipeItem = 1, NumOfPipeHTInt
Item = Item+1
! get the object name
CALL GetObjectItem(cCurrentModuleObject,PipeItem,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PipeHT%Name,Item-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PipeHT(Item)%Name = cAlphaArgs(1)
PipeHT(Item)%TypeOf = TypeOf_PipeInterior
! General user input data
PipeHT(Item)%Construction = cAlphaArgs(2)
PipeHT(Item)%ConstructionNum = FindIteminList(cAlphaArgs(2),Construct%Name,TotConstructs)
IF (PipeHT(Item)%ConstructionNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
! ELSE
! CALL ValidatePipeConstruction(TRIM(cCurrentModuleObject),TRIM(cAlphaArgs(2)),TRIM(cAlphaFieldNames(2)), &
! PipeHT(Item)%ConstructionNum,Item,ErrorsFound)
END IF
!get inlet node data
PipeHT(Item)%InletNode = cAlphaArgs(3)
PipeHT(Item)%InletNodeNum = GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
IF (PipeHT(Item)%InletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
! get outlet node data
PipeHT(Item)%OutletNode = cAlphaArgs(4)
PipeHT(Item)%OutletNodeNum = GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
IF (PipeHT(Item)%OutletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Pipe Nodes')
! get environmental boundary condition type
IF(lAlphaFieldBlanks(5)) cAlphaArgs(5) = 'ZONE'
SELECT CASE (cAlphaArgs(5))
CASE ('ZONE')
PipeHT(Item)%EnvironmentPtr = ZoneEnv
PipeHT(Item)%EnvrZone = cAlphaArgs(6)
PipeHT(Item)%EnvrZonePtr = FindItemInList(cAlphaArgs(6),Zone%Name,NumOfZones)
IF (PipeHT(Item)%EnvrZonePtr .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
END IF
CASE ('SCHEDULE')
PipeHT(Item)%EnvironmentPtr = ScheduleEnv
PipeHT(Item)%EnvrSchedule = cAlphaArgs(7)
PipeHT(Item)%EnvrSchedPtr = GetScheduleIndex(PipeHT(Item)%EnvrSchedule)
PipeHT(Item)%EnvrVelSchedule = cAlphaArgs(8)
PipeHT(Item)%EnvrVelSchedPtr = GetScheduleIndex(PipeHT(Item)%EnvrVelSchedule)
IF (PipeHT(Item)%EnvrSchedPtr .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
END IF
IF (PipeHT(Item)%EnvrVelSchedPtr .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(cAlphaArgs(8)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
END IF
CASE DEFAULT
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Should be "ZONE" or "SCHEDULE"') !TODO rename point
ErrorsFound = .TRUE.
END SELECT
! dimensions
PipeHT(Item)%PipeID = rNumericArgs(1)
IF (rNumericArgs(1) <= 0.0d0) THEN ! not really necessary because idd field has "minimum> 0"
CALL ShowSevereError('GetPipesHeatTransfer: invalid '//TRIM(cNumericFieldNames(1))// &
' of '//TRIM(RoundSigDigits(rNumericArgs(1), 4)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be > 0.0')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
PipeHT(Item)%Length = rNumericArgs(2)
IF (rNumericArgs(2) <= 0.0d0) THEN ! not really necessary because idd field has "minimum> 0"
CALL ShowSevereError('GetPipesHeatTransfer: invalid '//TRIM(cNumericFieldNames(2))//' of '// &
TRIM(RoundSigDigits(rNumericArgs(2), 4)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' must be > 0.0')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
IF (PipeHT(Item)%ConstructionNum /= 0) THEN
CALL ValidatePipeConstruction(TRIM(cCurrentModuleObject),TRIM(cAlphaArgs(2)),TRIM(cAlphaFieldNames(2)), &
PipeHT(Item)%ConstructionNum,Item,ErrorsFound)
END IF
END DO ! end of input loop
cCurrentModuleObject = 'Pipe:Outdoor'
DO PipeItem = 1, NumOfPipeHTExt
Item = Item + 1
! get the object name
CALL GetObjectItem(cCurrentModuleObject,PipeItem,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PipeHT%Name,Item-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PipeHT(Item)%Name = cAlphaArgs(1)
PipeHT(Item)%TypeOf = TypeOf_PipeExterior
! General user input data
PipeHT(Item)%Construction = cAlphaArgs(2)
PipeHT(Item)%ConstructionNum = FindIteminList(cAlphaArgs(2),Construct%Name,TotConstructs)
IF (PipeHT(Item)%ConstructionNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
! ELSE
! CALL ValidatePipeConstruction(TRIM(cCurrentModuleObject),TRIM(cAlphaArgs(2)),TRIM(cAlphaFieldNames(2)), &
! PipeHT(Item)%ConstructionNum,Item,ErrorsFound)
END IF
!get inlet node data
PipeHT(Item)%InletNode = cAlphaArgs(3)
PipeHT(Item)%InletNodeNum = GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
IF (PipeHT(Item)%InletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
! get outlet node data
PipeHT(Item)%OutletNode = cAlphaArgs(4)
PipeHT(Item)%OutletNodeNum = GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
IF (PipeHT(Item)%OutletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Pipe Nodes')
! get environmental boundary condition type
! PipeHT(Item)%Environment = 'OutdoorAir'
PipeHT(Item)%EnvironmentPtr = OutsideAirEnv
PipeHT(Item)%EnvrAirNode = cAlphaArgs(5)
PipeHT(Item)%EnvrAirNodeNum = GetOnlySingleNode(cAlphaArgs(5), ErrorsFound, &
TRIM(cCurrentModuleObject), cAlphaArgs(1), NodeType_Air, NodeConnectionType_OutsideAirReference, 1, ObjectIsNotParent)
IF (.not. lAlphaFieldBlanks(5) ) THEN
IF (.not. CheckOutAirNodeNumber(PipeHT(Item)%EnvrAirNodeNum)) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Outdoor Air Node not on OutdoorAir:NodeList or OutdoorAir:Node')
ErrorsFound=.true.
ENDIF
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('An '//TRIM(cAlphaFieldNames(5))//' must be used ')
ErrorsFound = .TRUE.
ENDIF
! dimensions
PipeHT(Item)%PipeID = rNumericArgs(1)
IF (rNumericArgs(1) <= 0.0d0) THEN ! not really necessary because idd field has "minimum> 0"
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//' of '//TRIM(RoundSigDigits(rNumericArgs(1), 4)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be > 0.0')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
PipeHT(Item)%Length = rNumericArgs(2)
IF (rNumericArgs(2) <= 0.0d0) THEN ! not really necessary because idd field has "minimum> 0"
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(2))//' of '//TRIM(RoundSigDigits(rNumericArgs(2), 4)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' must be > 0.0')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
IF (PipeHT(Item)%ConstructionNum /= 0) THEN
CALL ValidatePipeConstruction(TRIM(cCurrentModuleObject),TRIM(cAlphaArgs(2)),TRIM(cAlphaFieldNames(2)), &
PipeHT(Item)%ConstructionNum,Item,ErrorsFound)
END IF
END DO ! end of input loop
cCurrentModuleObject = 'Pipe:Underground'
DO PipeItem = 1, NumOfPipeHTUG
Item = Item + 1
! get the object name
CALL GetObjectItem(cCurrentModuleObject,PipeItem,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PipeHT%Name,Item-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PipeHT(Item)%Name = cAlphaArgs(1)
PipeHT(Item)%TypeOf = TypeOf_PipeUnderground
! General user input data
PipeHT(Item)%Construction = cAlphaArgs(2)
PipeHT(Item)%ConstructionNum = FindIteminList(cAlphaArgs(2),Construct%Name,TotConstructs)
IF (PipeHT(Item)%ConstructionNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
! ELSE
! CALL ValidatePipeConstruction(TRIM(cCurrentModuleObject),TRIM(cAlphaArgs(2)),TRIM(cAlphaFieldNames(2)), &
! PipeHT(Item)%ConstructionNum,Item,ErrorsFound)
END IF
!get inlet node data
PipeHT(Item)%InletNode = cAlphaArgs(3)
PipeHT(Item)%InletNodeNum = GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
IF (PipeHT(Item)%InletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
! get outlet node data
PipeHT(Item)%OutletNode = cAlphaArgs(4)
PipeHT(Item)%OutletNodeNum = GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
IF (PipeHT(Item)%OutletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Pipe Nodes')
PipeHT(Item)%EnvironmentPtr = GroundEnv
! Solar inclusion flag
! A6, \field Sun Exposure
IF (SameString(cAlphaArgs(5),'SUNEXPOSED')) THEN
PipeHT(Item)%SolarExposed = .TRUE.
ELSE IF (SameString(cAlphaArgs(5),'NOSUN')) THEN
PipeHT(Item)%SolarExposed = .FALSE.
ELSE
Call ShowSevereError('GetPipesHeatTransfer: invalid key for sun exposure flag for '//TRIM(cAlphaArgs(1)))
Call ShowContinueError('Key should be either SunExposed or NoSun. Entered Key: '//TRIM(cAlphaArgs(5)))
ErrorsFound = .TRUE.
ENDIF
! dimensions
PipeHT(Item)%PipeID = rNumericArgs(1)
IF (rNumericArgs(1) <= 0.0d0) THEN! not really necessary because idd field has "minimum> 0"
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//' of '//TRIM(RoundSigDigits(rNumericArgs(1), 4)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be > 0.0')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
PipeHT(Item)%Length = rNumericArgs(2)
IF (rNumericArgs(2) <= 0.0d0) THEN ! not really necessary because idd field has "minimum> 0"
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(2))//' of '//TRIM(RoundSigDigits(rNumericArgs(2), 4)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' must be > 0.0')
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
END IF
! Also get the soil material name
! A7, \field Soil Material
PipeHT(Item)%SoilMaterial = cAlphaArgs(6)
PipeHT(Item)%SoilMaterialNum = FindIteminList(cAlphaArgs(6),Material%Name,TotMaterials)
IF (PipeHT(Item)%SoilMaterialNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(PipeHT(Item)%SoilMaterial))
CALL ShowContinueError('Found in '//TRIM(cCurrentModuleObject)//'='//TRIM(PipeHT(Item)%Name))
ErrorsFound=.true.
ELSE
PipeHT(Item)%SoilDensity=Material(PipeHT(Item)%SoilMaterialNum)%Density
PipeHT(Item)%SoilDepth=Material(PipeHT(Item)%SoilMaterialNum)%Thickness
PipeHT(Item)%SoilCp=Material(PipeHT(Item)%SoilMaterialNum)%SpecHeat
PipeHT(Item)%SoilConductivity=Material(PipeHT(Item)%SoilMaterialNum)%Conductivity
PipeHT(Item)%SoilThermAbs=Material(PipeHT(Item)%SoilMaterialNum)%AbsorpThermal
PipeHT(Item)%SoilSolarAbs=Material(PipeHT(Item)%SoilMaterialNum)%AbsorpSolar
PipeHT(Item)%SoilRoughness=Material(PipeHT(Item)%SoilMaterialNum)%Roughness
PipeHT(Item)%PipeDepth=PipeHT(Item)%SoilDepth+PipeHT(Item)%PipeID/2.0d0
PipeHT(Item)%DomainDepth=PipeHT(Item)%PipeDepth*2.0d0
PipeHT(Item)%SoilDiffusivity=PipeHT(Item)%SoilConductivity/(PipeHT(Item)%SoilDensity*PipeHT(Item)%SoilCp)
PipeHT(Item)%SoilDiffusivityPerDay=PipeHT(Item)%SoilDiffusivity*SecondsInHour*HoursInDay
! Mesh the cartesian domain
PipeHT(Item)%NumDepthNodes=NumberOfDepthNodes
PipeHT(Item)%PipeNodeDepth = PipeHT(Item)%NumDepthNodes/2
PipeHT(Item)%PipeNodeWidth = PipeHT(Item)%NumDepthNodes/2
PipeHT(Item)%DomainDepth = PipeHT(Item)%PipeDepth * 2.0d0
PipeHT(Item)%dSregular = PipeHT(Item)%DomainDepth / (PipeHT(Item)%NumDepthNodes-1)
END IF
! Now we need to see if average annual temperature data is brought in here
IF (NumNumbers .GE. 3) THEN
PipeHT(Item)%AvgAnnualManualInput=1
!If so, we need to read in the data
! N3, \field Average soil surface temperature
PipeHT(Item)%AvgGroundTemp=rNumericArgs(3)
!IF (PipeHT(Item)%AvgGroundTemp == 0) THEN
! CALL ShowSevereError('GetPipesHeatTransfer: Invalid Average Ground Temp for PIPE:UNDERGROUND=' &
! //TRIM(PipeHT(Item)%Name))
! CALL ShowContinueError('If any one annual ground temperature item is entered, all 3 items must be entered')
! ErrorsFound=.true.
!ENDIF
! N4, \field Amplitude of soil surface temperature
IF (NumNumbers >= 4) THEN
PipeHT(Item)%AvgGndTempAmp=rNumericArgs(4)
IF (PipeHT(Item)%AvgGndTempAmp < 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(4))//'='//TRIM(RoundSigDigits(PipeHT(Item)%AvgGndTempAmp,2)))
CALL ShowContinueError('Found in '//TRIM(cCurrentModuleObject)//'='//TRIM(PipeHT(Item)%Name))
ErrorsFound=.true.
ENDIF
ENDIF
! N5; \field Phase constant of soil surface temperature
IF (NumNumbers >= 5) THEN
PipeHT(Item)%PhaseShiftDays=rNumericArgs(5)
IF (PipeHT(Item)%PhaseShiftDays < 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(5))//'='//TRIM(RoundSigDigits(PipeHT(Item)%PhaseShiftDays)))
CALL ShowContinueError('Found in '//TRIM(cCurrentModuleObject)//'='//TRIM(PipeHT(Item)%Name))
ErrorsFound=.true.
ENDIF
ENDIF
IF (NumNumbers >=3 .and. NumNumbers < 5) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(PipeHT(Item)%Name))
CALL ShowContinueError('If any one annual ground temperature item is entered, all 3 items must be entered')
ErrorsFound=.true.
ENDIF
ENDIF
IF (PipeHT(Item)%ConstructionNum /= 0) THEN
CALL ValidatePipeConstruction(TRIM(cCurrentModuleObject),TRIM(cAlphaArgs(2)),TRIM(cAlphaFieldNames(2)), &
PipeHT(Item)%ConstructionNum,Item,ErrorsFound)
END IF
! Select number of pipe sections. Hanby's optimal number of 20 section is selected.
NumSections = NumPipeSections
PipeHT(Item)%NumSections = NumPipeSections
! For buried pipes, we need to allocate the cartesian finite difference array
ALLOCATE(PipeHT(Item)%T(TentativeTimeIndex, &
PipeHT(Item)%NumSections, &
PipeHT(Item)%NumDepthNodes, &
PipeHT(Item)%PipeNodeWidth))
PipeHT(Item)%T=0.0d0
END DO ! PipeUG input loop
DO Item=1,NumofPipeHT
! Select number of pipe sections. Hanby's optimal number of 20 section is selected.
NumSections = NumPipeSections
PipeHT(Item)%NumSections = NumPipeSections
! We need to allocate the Hanby model arrays for all pipes, including buried
ALLOCATE(PipeHT(Item)%TentativeFluidTemp(0:NumSections), PipeHT(Item)%TentativePipeTemp(0:NumSections), &
PipeHT(Item)%FluidTemp(0:NumSections), PipeHT(Item)%PreviousFluidTemp(0:NumSections), &
PipeHT(Item)%PipeTemp(0:NumSections), PipeHT(Item)%PreviousPipeTemp(0:NumSections))
PipeHT(Item)%TentativeFluidTemp = 0.0d0
PipeHT(Item)%FluidTemp = 0.0d0
PipeHT(Item)%PreviousFluidTemp = 0.0d0
PipeHT(Item)%TentativePipeTemp = 0.0d0
PipeHT(Item)%PipeTemp = 0.0d0
PipeHT(Item)%PreviousPipeTemp = 0.0d0
! work out heat transfer areas (area per section)
PipeHT(Item)%InsideArea = PI * PipeHT(Item)%PipeID * PipeHT(Item)%Length/NumSections
PipeHT(Item)%OutsideArea = PI * (PipeHT(Item)%PipeOD + 2*PipeHT(Item)%InsulationThickness) * &
PipeHT(Item)%Length/NumSections
! cross sectional area
PipeHT(Item)%SectionArea = PI * 0.25d0 * PipeHT(Item)%PipeID**2
! pipe & insulation mass
PipeHT(Item)%PipeHeatCapacity = PipeHT(Item)%PipeCp * PipeHT(Item)%PipeDensity * & ! the metal component
(PI * 0.25d0 * PipeHT(Item)%PipeOD**2 - PipeHT(Item)%SectionArea)
ENDDO
! final error check
IF (ErrorsFound) THEN
CALL ShowFatalError('GetPipesHeatTransfer: Errors found in input. Preceding conditions cause termination.')
END IF
! Set up the output variables CurrentModuleObject='Pipe:Indoor/Outdoor/Underground'
DO Item = 1, NumOfPipeHT
CALL SetupOutputVariable('Pipe Fluid Heat Transfer Rate [W]', &
PipeHTReport(Item)%FluidHeatLossRate,'Plant','Average', &
PipeHT(Item)%Name)
CALL SetupOutputVariable('Pipe Fluid Heat Transfer Energy [J]', &
PipeHTReport(Item)%FluidHeatLossEnergy,'Plant','Sum',PipeHT(Item)%Name)
IF(PipeHT(Item)%EnvironmentPtr .EQ. ZoneEnv)THEN
CALL SetupOutputVariable('Pipe Ambient Heat Transfer Rate [W]', &
PipeHTReport(Item)%EnvironmentHeatLossRate,'Plant','Average', &
PipeHT(Item)%Name)
CALL SetupOutputVariable('Pipe Ambient Heat Transfer Energy [J]', &
PipeHTReport(Item)%EnvHeatLossEnergy,'Plant','Sum',PipeHT(Item)%Name)
CALL SetupZoneInternalGain(PipeHT(Item)%EnvrZonePtr, &
'Pipe:Indoor', &
PipeHT(Item)%Name, &
IntGainTypeOf_PipeIndoor, &
ConvectionGainRate = PipeHT(Item)%ZoneHeatGainRate)
ENDIF
CALL SetupOutputVariable('Pipe Mass Flow Rate [kg/s]', &
PipeHTReport(Item)%MassFlowRate,'Plant','Average', &
PipeHT(Item)%Name)
CALL SetupOutputVariable('Pipe Volume Flow Rate [m3/s]', &
PipeHTReport(Item)%VolumeFlowRate,'Plant','Average', &
PipeHT(Item)%Name)
CALL SetupOutputVariable('Pipe Inlet Temperature [C]', &
PipeHTReport(Item)%FluidInletTemp,'Plant','Average', &
PipeHT(Item)%Name)
CALL SetupOutputVariable('Pipe Outlet Temperature [C]', &
PipeHTReport(Item)%FluidOutletTemp,'Plant','Average',&
PipeHT(Item)%Name)
END DO
RETURN
END SUBROUTINE GetPipesHeatTransfer