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 GetTDDInput
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN May 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the input for TDD pipes and does some error checking.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! REFERENCES: na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, FindItemInList, GetObjectItem, VerifyName
USE DataDaylighting, ONLY: ZoneDaylight
USE General, ONLY: RoundSigDigits, SafeDivide
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS: na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!unused1208 CHARACTER(len=MaxNameLength), &
! DIMENSION(20) :: Alphas ! Alpha items for object
LOGICAL :: ErrorsFound = .FALSE. ! Set to true if errors in input, fatal at end of routine
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: IsBlank ! TRUE if the name is blank
LOGICAL :: IsNotOk ! TRUE if there was a problem with a list name
!unused1208 REAL(r64), DIMENSION(9) :: Numbers ! Numeric items for object
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: PipeNum ! TDD pipe object number
INTEGER :: SurfNum ! Dome or diffuser surface
INTEGER :: TZoneNum ! Transition zone loop
CHARACTER(len=MaxNameLength) :: TZoneName ! Transition zone name
REAL(r64) :: PipeArea
! FLOW:
cCurrentModuleObject='DaylightingDevice:Tubular'
NumOfTDDPipes = GetNumObjectsFound(cCurrentModuleObject)
IF (NumOfTDDPipes > 0) THEN
ALLOCATE(TDDPipe(NumOfTDDPipes))
DO PipeNum = 1, NumOfTDDPipes
CALL GetObjectItem(cCurrentModuleObject,PipeNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Pipe name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),TDDPipe%Name,PipeNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
TDDPipe(PipeNum)%Name = cAlphaArgs(1)
! Get TDD:DOME object
SurfNum = FindItemInList(cAlphaArgs(2),Surface%Name,TotSurfaces)
IF (SurfNum == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' not found.')
ErrorsFound = .TRUE.
ELSE
IF (FindTDDPipe(SurfNum) > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' is referenced by more than one TDD.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%Class .NE. SurfaceClass_TDD_Dome) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' is not of surface type TubularDaylightDome.')
ErrorsFound = .TRUE.
END IF
IF (Construct(Surface(SurfNum)%Construction)%TotGlassLayers > 1) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' construction ('// &
trim(Construct(Surface(SurfNum)%Construction)%Name)//') must have only 1 glass layer.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%WindowShadingControlPtr > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' must not have a shading control.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%FrameDivider > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' must not have a frame/divider.')
ErrorsFound = .TRUE.
END IF
IF (Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' Equivalent Layer Window is not supported.')
ErrorsFound = .TRUE.
ENDIF
! Window multiplier is already handled in SurfaceGeometry.f90
IF (.NOT. Surface(SurfNum)%ExtSolar) THEN
CALL ShowWarningError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome '//TRIM(cAlphaArgs(2))//' is not exposed to exterior radiation.')
END IF
TDDPipe(PipeNum)%Dome = SurfNum
END IF
! Get TDD:DIFFUSER object
SurfNum = FindItemInList(cAlphaArgs(3),Surface%Name,TotSurfaces)
IF (SurfNum == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(3))//' not found.')
ErrorsFound = .TRUE.
ELSE
IF (FindTDDPipe(SurfNum) > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(3))//' is referenced by more than one TDD.')
ErrorsFound = .TRUE.
END IF
IF (SurfaceWindow(SurfNum)%OriginalClass .NE. SurfaceClass_TDD_Diffuser) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(3))//' is not of surface type TubularDaylightDiffuser.')
ErrorsFound = .TRUE.
END IF
IF (Construct(Surface(SurfNum)%Construction)%TotGlassLayers > 1) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(3))//' construction ('// &
trim(Construct(Surface(SurfNum)%Construction)%Name)//') must have only 1 glass layer.')
ErrorsFound = .TRUE.
END IF
IF (Construct(Surface(SurfNum)%Construction)%Transdiff <= 1.d-10) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(3))//' construction ('// &
trim(Construct(Surface(SurfNum)%Construction)%Name)//') invalid value.')
CALL ShowContinueError('Diffuse solar transmittance of construction ['// &
trim(RoundSigDigits(Construct(Surface(SurfNum)%Construction)%Transdiff,4))//'] too small for calculations.')
ErrorsFound = .TRUE.
END IF
IF (TDDPipe(PipeNum)%Dome > 0 .AND. ABS(Surface(SurfNum)%Area - Surface(TDDPipe(PipeNum)%Dome)%Area) > 0.1d0) THEN
IF (SafeDivide(ABS(Surface(SurfNum)%Area - Surface(TDDPipe(PipeNum)%Dome)%Area), &
Surface(TDDPipe(PipeNum)%Dome)%Area) > .1d0) THEN ! greater than 10%
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome and diffuser areas are significantly different (>10%).')
CALL ShowContinueError('...Diffuser Area=['//trim(RoundSigDigits(Surface(SurfNum)%Area,4))// &
']; Dome Area=['//trim(RoundSigDigits(Surface(TDDPipe(PipeNum)%Dome)%Area,4))//'].')
ErrorsFound = .TRUE.
ELSE
CALL ShowWarningError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Dome and diffuser areas differ by > .1 m2.')
CALL ShowContinueError('...Diffuser Area=['//trim(RoundSigDigits(Surface(SurfNum)%Area,4))// &
']; Dome Area=['//trim(RoundSigDigits(Surface(TDDPipe(PipeNum)%Dome)%Area,4))//'].')
ENDIF
END IF
IF (Surface(SurfNum)%WindowShadingControlPtr > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(3))//' must not have a shading control.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%FrameDivider > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(3))//' must not have a frame/divider.')
ErrorsFound = .TRUE.
END IF
IF (Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Diffuser '//TRIM(cAlphaArgs(2))//' Equivalent Layer Window is not supported.')
ErrorsFound = .TRUE.
ENDIF
! Window multiplier is already handled in SurfaceGeometry.f90
TDDPipe(PipeNum)%Diffuser = SurfNum
END IF
! Construction
TDDPipe(PipeNum)%Construction = FindItemInList(cAlphaArgs(4),Construct%Name,TotConstructs)
IF(TDDPipe(PipeNum)%Construction == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Pipe construction '//TRIM(cAlphaArgs(4))//' not found.')
ErrorsFound = .TRUE.
ELSE
Construct(TDDPipe(PipeNum)%Construction)%IsUsed=.true.
END IF
IF (rNumericArgs(1) > 0) THEN
TDDPipe(PipeNum)%Diameter = rNumericArgs(1)
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Pipe diameter must be greater than zero.')
ErrorsFound = .TRUE.
END IF
PipeArea=0.25d0 * Pi * TDDPipe(PipeNum)%Diameter**2
IF (TDDPipe(PipeNum)%Dome > 0 .AND. ABS(PipeArea - Surface(TDDPipe(PipeNum)%Dome)%Area) > 0.1d0) THEN
IF (SafeDivide(ABS(PipeArea - Surface(TDDPipe(PipeNum)%Dome)%Area), &
Surface(TDDPipe(PipeNum)%Dome)%Area) > .1d0) THEN ! greater than 10%
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Pipe and dome/diffuser areas are significantly different (>10%).')
CALL ShowContinueError('...Pipe Area=['//trim(RoundSigDigits(PipeArea,4))//']; Dome/Diffuser Area=['// &
trim(RoundSigDigits(Surface(TDDPipe(PipeNum)%Dome)%Area,4))//'].')
ErrorsFound = .TRUE.
ELSE
CALL ShowWarningError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Pipe and dome/diffuser areas differ by > .1 m2.')
CALL ShowContinueError('...Pipe Area=['//trim(RoundSigDigits(PipeArea,4))//']; Dome/Diffuser Area=['// &
trim(RoundSigDigits(Surface(TDDPipe(PipeNum)%Dome)%Area,4))//'].')
ENDIF
END IF
IF (rNumericArgs(2) > 0) THEN
TDDPipe(PipeNum)%TotLength = rNumericArgs(2)
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Pipe length must be greater than zero.')
ErrorsFound = .TRUE.
END IF
IF (rNumericArgs(3) > 0) THEN
TDDPipe(PipeNum)%Reff = rNumericArgs(3)
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Effective thermal resistance (R value) must be greater than zero.')
ErrorsFound = .TRUE.
END IF
! Transition zones
TDDPipe(PipeNum)%NumOfTZones = NumAlphas - 4
IF (TDDPipe(PipeNum)%NumOfTZones < 1) THEN
CALL ShowWarningError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': No transition zones specified. All pipe absorbed solar goes to exterior.')
ELSE IF (TDDPipe(PipeNum)%NumOfTZones > MaxTZones) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Maximum number of transition zones exceeded.')
ErrorsFound = .TRUE.
ELSE
ALLOCATE(TDDPipe(PipeNum)%TZone(TDDPipe(PipeNum)%NumOfTZones))
ALLOCATE(TDDPipe(PipeNum)%TZoneLength(TDDPipe(PipeNum)%NumOfTZones))
ALLOCATE(TDDPipe(PipeNum)%TZoneHeatGain(TDDPipe(PipeNum)%NumOfTZones))
TDDPipe(PipeNum)%TZone = 0
TDDPipe(PipeNum)%TZoneLength = 0.d0
TDDPipe(PipeNum)%TZoneHeatGain = 0.d0
DO TZoneNum = 1, TDDPipe(PipeNum)%NumOfTZones
TZoneName = cAlphaArgs(TZoneNum + 4)
TDDPipe(PipeNum)%TZone(TZoneNum) = FindItemInList(TZoneName,Zone%Name,NumOfZones)
IF (TDDPipe(PipeNum)%TZone(TZoneNum) == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Transition zone '//TRIM(TZoneName)//' not found.')
ErrorsFound = .TRUE.
END IF
TDDPipe(PipeNum)%TZoneLength(TZoneNum) = rNumericArgs(TZoneNum + 3)
IF (TDDPipe(PipeNum)%TZoneLength(TZoneNum) < 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1)) &
//': Transition zone length for '//TRIM(TZoneName)//' must be zero or greater.')
ErrorsFound = .TRUE.
END IF
END DO ! TZoneNum
END IF
END DO ! PipeNum
IF (ErrorsFound) CALL ShowFatalError('Errors in DaylightingDevice:Tubular input.')
END IF
RETURN
END SUBROUTINE GetTDDInput