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 GetGroundheatExchangerInput
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: August, 2000
! MODIFIED Arun Murugappan
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine needs a description.
! METHODOLOGY EMPLOYED:
! Needs description, as appropriate.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName
USE DataIPShortCuts
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE General, ONLY: TrimSigDigits,RoundSigDigits
USE DataEnvironment, ONLY: MaxNumberSimYears
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 :: GlheNum
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
LOGICAL, SAVE :: ErrorsFound=.FALSE.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: IndexNum
INTEGER :: PairNum
LOGICAL :: Allocated
!GET NUMBER OF ALL EQUIPMENT TYPES
cCurrentModuleObject = 'GroundHeatExchanger:Vertical'
NumVerticalGlhes = GetNumObjectsFound(cCurrentModuleObject)
Allocated = .FALSE.
IF (NumVerticalGlhes <= 0 ) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment found in input file')
ErrorsFound = .true.
ENDIF
ALLOCATE (VerticalGlhe(NumVerticalGlhes))
ALLOCATE (VerticalGlheReport(NumVerticalGlhes))
ALLOCATE(CheckEquipName(NumVerticalGlhes))
CheckEquipName=.true.
DO GlheNum = 1 , NumVerticalGlhes
CALL GetObjectItem(cCurrentModuleObject,GlheNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
!get object name
CALL VerifyName(cAlphaArgs(1),VerticalGlhe%Name,GlheNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
VerticalGlhe(GlheNum)%Name = cAlphaArgs(1)
!get inlet node num
VerticalGlhe(GlheNum)%GlheInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
!get outlet node num
VerticalGlhe(GlheNum)%GlheOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
verticalglhe(GlheNum)%Available = .TRUE.
verticalglhe(GlheNum)%On = .TRUE.
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3), &
'Condenser Water Nodes')
!load borehole data
VerticalGlhe(GlheNum)%DesignFlow = rNumericArgs(1)
CALL RegisterPlantCompDesignFlow (VerticalGlhe(GlheNum)%GlheInletNodeNum, VerticalGlhe(GlheNum)%DesignFlow)
VerticalGlhe(GlheNum)%NumBoreholes = rNumericArgs(2)
VerticalGlhe(GlheNum)%BoreholeLength = rNumericArgs(3)
VerticalGlhe(GlheNum)%BoreholeRadius = rNumericArgs(4)
VerticalGlhe(GlheNum)%KGround = rNumericArgs(5)
VerticalGlhe(GlheNum)%CpRhoGround = rNumericArgs(6)
VerticalGlhe(GlheNum)%TempGround = rNumericArgs(7)
VerticalGlhe(GlheNum)%MaxGlheFlowRate = rNumericArgs(8)
VerticalGlhe(GlheNum)%KGrout = rNumericArgs(9)
VerticalGlhe(GlheNum)%KPipe = rNumericArgs(10)
VerticalGlhe(GlheNum)%PipeOutDia = rNumericArgs(11)
VerticalGlhe(GlheNum)%UtubeDist = rNumericArgs(12)
VerticalGlhe(GlheNum)%PipeThick = rNumericArgs(13)
VerticalGlhe(GlheNum)%MaxSimYears = rNumericArgs(14)
VerticalGlhe(GlheNum)%gReferenceRatio = rNumericArgs(15)
! Not many checks
IF (VerticalGlhe(GlheNum)%PipeThick >= VerticalGlhe(GlheNum)%PipeOutDia/2.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(VerticalGlhe(GlheNum)%Name)// &
'", invalid value in field.')
CALL ShowContinueError('...'//trim(cNumericFieldNames(13))//'=['// &
trim(RoundSigDigits(VerticalGlhe(GlheNum)%PipeThick,3))//'].')
CALL ShowContinueError('...'//trim(cNumericFieldNames(11))//'=['// &
trim(RoundSigDigits(VerticalGlhe(GlheNum)%PipeOutDia,3))//'].')
CALL ShowContinueError('...Radius will be <=0.')
ErrorsFound=.true.
ENDIF
IF (VerticalGlhe(GlheNum)%MaxSimYears < MaxNumberSimYears) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//trim(VerticalGlhe(GlheNum)%Name)// &
'", invalid value in field.')
CALL ShowContinueError('...'//trim(cNumericFieldNames(14))//' less than RunPeriod Request')
CALL ShowContinueError('Requested input='//TRIM(TrimSigDigits(VerticalGlhe(GlheNum)%MaxSimYears))// &
' will be set to '//TRIM(TrimSigDigits(MaxNumberSimYears)))
VerticalGlhe(GlheNum)%MaxSimYears=MaxNumberSimYears
ENDIF
! Get Gfunction data
VerticalGlhe(GlheNum)%NPairs = rNumericArgs(16)
VerticalGlhe(GlheNum)%SubAGG = 15
VerticalGlhe(GlheNum)%AGG = 192
! Allocation of all the dynamic arrays
ALLOCATE (VerticalGlhe(GlheNum)%LNTTS(VerticalGlhe(GlheNum)%NPairs))
VerticalGlhe(GlheNum)%LNTTS=0.0d0
ALLOCATE (VerticalGlhe(GlheNum)%GFNC(VerticalGlhe(GlheNum)%NPairs))
VerticalGlhe(GlheNum)%GFNC=0.0d0
ALLOCATE (VerticalGlhe(GlheNum)%QnMonthlyAgg(VerticalGlhe(GlheNum)%MaxSimYears*12))
VerticalGlhe(GlheNum)%QnMonthlyAgg=0.0d0
ALLOCATE (VerticalGlhe(GlheNum)%QnHr(730+ VerticalGlhe(GlheNum)%AGG+ &
VerticalGlhe(GlheNum)%SubAGG))
VerticalGlhe(GlheNum)%QnHr=0.0d0
ALLOCATE (VerticalGlhe(GlheNum)%QnSubHr((VerticalGlhe(GlheNum)%SubAGG+1)*MaxTSinHr+1))
VerticalGlhe(GlheNum)%QnSubHr=0.0d0
ALLOCATE (VerticalGlhe(GlheNum)%LastHourN(VerticalGlhe(GlheNum)%SubAGG+1))
VerticalGlhe(GlheNum)%LastHourN=0
IF(.NOT.Allocated)THEN
ALLOCATE (PrevTimeSteps((VerticalGlhe(GlheNum)%SubAGG+1)*MaxTSinHr+1))
PrevTimeSteps=0.0d0
Allocated = .TRUE.
END IF
IndexNum = 17
Do PairNum = 1, VerticalGlhe(GlheNum)%NPairs
VerticalGlhe(GlheNum)%LNTTS(PairNum) = rNumericArgs(IndexNum)
VerticalGlhe(GlheNum)%GFNC(PairNum) = rNumericArgs(IndexNum+1)
IndexNum=IndexNum+2
End Do
!Check for Errors
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
ENDIF
END DO
!Set up report variables
DO GlheNum = 1, NumVerticalGlhes
CALL SetupOutputVariable('Ground Heat Exchanger Average Borehole Temperature [C]', &
VerticalGlheReport(GlheNum)%GlheBoreholeTemp,'System','Average',VerticalGlhe(GlheNum)%Name)
CALL SetupOutputVariable('Ground Heat Exchanger Heat Transfer Rate [W]', &
VerticalGlheReport(GlheNum)%QGlhe,'System','Average',VerticalGlhe(GlheNum)%Name)
CALL SetupOutputVariable('Ground Heat Exchanger Inlet Temperature [C]', &
VerticalGlheReport(GlheNum)%GlheInletTemp,'System','Average',VerticalGlhe(GlheNum)%Name)
CALL SetupOutputVariable('Ground Heat Exchanger Outlet Temperature [C]', &
VerticalGlheReport(GlheNum)%GlheOutletTemp,'System','Average',VerticalGlhe(GlheNum)%Name)
CALL SetupOutputVariable('Ground Heat Exchanger Mass Flow Rate [kg/s]', &
VerticalGlheReport(GlheNum)%GlheMassFlowRate,'System','Average',VerticalGlhe(GlheNum)%Name)
CALL SetupOutputVariable('Ground Heat Exchanger Average Fluid Temperature [C]', &
VerticalGlheReport(GlheNum)%GlheAveFluidTemp,'System','Average',VerticalGlhe(GlheNum)%Name)
END DO
RETURN
END SUBROUTINE GetGroundheatExchangerInput