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 GetShelfInput
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN August 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the input for light shelves and does some error checking.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! REFERENCES: na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, FindItemInList, GetObjectItem, VerifyName
USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS: na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
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
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: ShelfNum ! Daylighting shelf object number
INTEGER :: SurfNum ! Window, inside, or outside shelf surfaces
INTEGER :: ConstrNum ! Outside shelf construction object number
! FLOW:
cCurrentModuleObject='DaylightingDevice:Shelf'
NumOfShelf = GetNumObjectsFound(cCurrentModuleObject)
IF (NumOfShelf > 0) THEN
ALLOCATE(Shelf(NumOfShelf))
DO ShelfNum = 1, NumOfShelf
CALL GetObjectItem('DaylightingDevice:Shelf',ShelfNum,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Shelf name
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),Shelf%Name,ShelfNum-1,IsNotOK,IsBlank,'DaylightingDevice:Shelf')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
Shelf(ShelfNum)%Name = cAlphaArgs(1)
! Get window object
SurfNum = FindItemInList(cAlphaArgs(2),Surface%Name,TotSurfaces)
IF (SurfNum == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Window '//TRIM(cAlphaArgs(2))//' not found.')
ErrorsFound = .TRUE.
ELSE
IF (Surface(SurfNum)%Class .NE. SurfaceClass_Window) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Window '//TRIM(cAlphaArgs(2))//' is not of surface type WINDOW.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%Shelf > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Window '//TRIM(cAlphaArgs(2))//' is referenced by more than one shelf.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%WindowShadingControlPtr > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Window '//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))// &
': Window '//TRIM(cAlphaArgs(2))//' must not have a frame/divider.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%Sides /= 4) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Window '//TRIM(cAlphaArgs(2))//' must have 4 sides.')
ErrorsFound = .TRUE.
END IF
!
IF (Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Window '//TRIM(cAlphaArgs(2))//' Equivalent Layer Window is not supported.')
ErrorsFound = .TRUE.
ENDIF
Shelf(ShelfNum)%Window = SurfNum
Surface(SurfNum)%Shelf = ShelfNum
END IF
! Get inside shelf heat transfer surface (optional)
IF (cAlphaArgs(3) .NE. '') THEN
SurfNum = FindItemInList(cAlphaArgs(3),Surface%Name,TotSurfaces)
IF (SurfNum == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Inside shelf '//TRIM(cAlphaArgs(3))//' not found.')
ErrorsFound = .TRUE.
ELSE
! No error if shelf belongs to more than one window, e.g. concave corners
IF (Surface(SurfNum)%ExtBoundCond .NE. SurfNum) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Inside shelf '//TRIM(cAlphaArgs(3))// &
' must be its own Outside Boundary Condition Object.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%Sides /= 4) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Inside shelf '//TRIM(cAlphaArgs(3))//' must have 4 sides.')
ErrorsFound = .TRUE.
END IF
Shelf(ShelfNum)%InSurf = SurfNum
END IF
END IF
! Get outside shelf attached shading surface (optional)
IF (cAlphaArgs(4) .NE. '') THEN
SurfNum = FindItemInList(cAlphaArgs(4),Surface%Name,TotSurfaces)
IF (SurfNum == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Outside shelf '//TRIM(cAlphaArgs(4))//' not found.')
ErrorsFound = .TRUE.
ELSE
! No error if shelf belongs to more than one window, e.g. concave corners
IF (Surface(SurfNum)%Class .NE. SurfaceClass_Shading) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Outside shelf '//TRIM(cAlphaArgs(4))//' is not a Shading:Zone:Detailed object.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%SchedShadowSurfIndex > 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Outside shelf '//TRIM(cAlphaArgs(4))//' must not have a transmittance schedule.')
ErrorsFound = .TRUE.
END IF
IF (Surface(SurfNum)%Sides /= 4) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Outside shelf '//TRIM(cAlphaArgs(4))//' must have 4 sides.')
ErrorsFound = .TRUE.
END IF
! Get outside shelf construction (required if outside shelf is specified)
IF (cAlphaArgs(5) .NE. '') THEN
ConstrNum = FindIteminList(cAlphaArgs(5),Construct%Name,TotConstructs)
IF (ConstrNum == 0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Outside shelf construction '//TRIM(cAlphaArgs(5))//' not found.')
ErrorsFound = .TRUE.
ELSE IF (Construct(ConstrNum)%TypeIsWindow) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Outside shelf construction '//TRIM(cAlphaArgs(5))//' must not have WindowMaterial:Glazing.')
ErrorsFound = .TRUE.
ELSE
Shelf(ShelfNum)%Construction = ConstrNum
Construct(ConstrNum)%IsUsed=.true.
END IF
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': Outside shelf requires an outside shelf construction to be specified.')
ErrorsFound = .TRUE.
END IF
! Get view factor to outside shelf (optional)
IF (NumNumbers > 0) THEN
Shelf(ShelfNum)%ViewFactor = rNumericArgs(1)
IF (rNumericArgs(1) == 0.0d0) THEN
CALL ShowWarningError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': View factor to outside shelf is zero. Shelf does not reflect on window.')
END IF
ELSE
Shelf(ShelfNum)%ViewFactor = -1.0d0! Flag to have the view factor calculated during initialization
END IF
Shelf(ShelfNum)%OutSurf = SurfNum
! Reset some properties of the SURFACE:SHADING:ATTACHED object in order to receive radiation and shading
! Normally this would be done during initialization, but that's not early enough for some shading calculations
Surface(SurfNum)%BaseSurf = SurfNum
Surface(SurfNum)%HeatTransSurf = .TRUE.
Surface(SurfNum)%Construction = ConstrNum ! Kludge to allow shading surface to be a heat transfer surface
Construct(ConstrNum)%IsUsed=.true.
END IF
END IF
IF (Shelf(ShelfNum)%InSurf == 0 .AND. Shelf(ShelfNum)%OutSurf == 0) &
CALL ShowWarningError(trim(cCurrentModuleObject)//' = '//TRIM(cAlphaArgs(1))// &
': No inside shelf or outside shelf was specified.')
END DO ! ShelfNum
IF (ErrorsFound) CALL ShowFatalError('Errors in DaylightingDevice:Shelf input.')
END IF
RETURN
END SUBROUTINE GetShelfInput