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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound |
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 GetFrameAndDividerData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN May 2000
! MODIFIED April 2002 (FCW): get window reveal data
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets input data for window frame and/or divider and/or window
! inside/outside reveal.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, VerifyName
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! set to true if errors found in input
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat ! IO Status when calling get input subroutine
CHARACTER(len=MaxNameLength),DIMENSION(2) &
:: FrameDividerNames ! Frame/Divider Alpha names
INTEGER :: FrameDividerNum ! Counter to keep track of the frame/divider number
INTEGER :: FrameDividerNumAlpha ! Number of frame/divider alpha names being passed
INTEGER :: FrameDividerNumProp ! Number of frame/divider properties being passed
REAL(r64), DIMENSION(23) :: FrameDividerProps !Temporary array to transfer frame/divider properties
INTEGER :: Loop
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
CurrentModuleObject='WindowProperty:FrameAndDivider'
TotFrameDivider=GetNumObjectsFound(CurrentModuleObject)
ALLOCATE (FrameDivider(TotFrameDivider))
IF(TotFrameDivider == 0) RETURN
FrameDividerNum=0
DO Loop=1,TotFrameDivider
!Call Input Get routine to retrieve frame/divider data
CALL GetObjectItem(CurrentModuleObject,Loop,FrameDividerNames,FrameDividerNumAlpha, &
FrameDividerProps,FrameDividerNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(FrameDividerNames(1),FrameDivider%Name,FrameDividerNum,ErrorInName,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
!Load the frame/divider derived type from the input data.
FrameDividerNum=FrameDividerNum+1
FrameDivider(FrameDividerNum)%Name = FrameDividerNames(1)
FrameDivider(FrameDividerNum)%FrameWidth = FrameDividerProps(1)
FrameDivider(FrameDividerNum)%FrameProjectionOut = FrameDividerProps(2)
FrameDivider(FrameDividerNum)%FrameProjectionIn = FrameDividerProps(3)
IF(FrameDivider(FrameDividerNum)%FrameWidth == 0.0d0) THEN
FrameDivider(FrameDividerNum)%FrameProjectionOut = 0.0d0
FrameDivider(FrameDividerNum)%FrameProjectionIn = 0.0d0
END IF
FrameDivider(FrameDividerNum)%FrameConductance = FrameDividerProps(4)
FrameDivider(FrameDividerNum)%FrEdgeToCenterGlCondRatio = FrameDividerProps(5)
FrameDivider(FrameDividerNum)%FrameSolAbsorp = FrameDividerProps(6)
FrameDivider(FrameDividerNum)%FrameVisAbsorp = FrameDividerProps(7)
FrameDivider(FrameDividerNum)%FrameEmis = FrameDividerProps(8)
IF (SameString(FrameDividerNames(2),'DividedLite')) THEN
FrameDivider(FrameDividerNum)%DividerType = DividedLite
ELSEIF (SameString(FrameDividerNames(2),'Suspended')) THEN
FrameDivider(FrameDividerNum)%DividerType = Suspended
ELSE
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(FrameDividerNames(1))// &
'", Invalid '//TRIM(cAlphaFieldNames(2)))
CALL ShowContinueError('Entered="'//trim(FrameDividerNames(2))// &
'", must be DividedLite or Suspended. Will be set to DividedLite.')
FrameDivider(FrameDividerNum)%DividerType = DividedLite
ENDIF
FrameDivider(FrameDividerNum)%DividerWidth = FrameDividerProps(9)
FrameDivider(FrameDividerNum)%HorDividers = FrameDividerProps(10)
FrameDivider(FrameDividerNum)%VertDividers = FrameDividerProps(11)
FrameDivider(FrameDividerNum)%DividerProjectionOut = FrameDividerProps(12)
FrameDivider(FrameDividerNum)%DividerProjectionIn = FrameDividerProps(13)
IF(FrameDivider(FrameDividerNum)%DividerWidth == 0.0d0 .OR. &
FrameDivider(FrameDividerNum)%DividerType == Suspended) THEN
FrameDivider(FrameDividerNum)%DividerProjectionOut = 0.0d0
FrameDivider(FrameDividerNum)%DividerProjectionIn = 0.0d0
END IF
FrameDivider(FrameDividerNum)%DividerConductance = FrameDividerProps(14)
FrameDivider(FrameDividerNum)%DivEdgeToCenterGlCondRatio = FrameDividerProps(15)
FrameDivider(FrameDividerNum)%DividerSolAbsorp = FrameDividerProps(16)
FrameDivider(FrameDividerNum)%DividerVisAbsorp = FrameDividerProps(17)
FrameDivider(FrameDividerNum)%DividerEmis = FrameDividerProps(18)
FrameDivider(FrameDividerNum)%OutsideRevealSolAbs = FrameDividerProps(19)
FrameDivider(FrameDividerNum)%InsideSillDepth = FrameDividerProps(20)
FrameDivider(FrameDividerNum)%InsideSillSolAbs = FrameDividerProps(21)
FrameDivider(FrameDividerNum)%InsideReveal = FrameDividerProps(22)
FrameDivider(FrameDividerNum)%InsideRevealSolAbs = FrameDividerProps(23)
IF (FrameDivider(FrameDividerNum)%DividerWidth > 0.0d0 .and. &
(FrameDivider(FrameDividerNum)%HorDividers == 0 .and. FrameDivider(FrameDividerNum)%VertDividers == 0)) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': In FrameAndDivider '//TRIM(FrameDivider(FrameDividerNum)%Name)// &
' '//TRIM(cNumericFieldNames(9))//' > 0 ')
CALL ShowContinueError('...but '//TRIM(cNumericFieldNames(10))//' = 0 and '// &
TRIM(cNumericFieldNames(11))//' = 0.')
CALL ShowContinueError('...'//TRIM(cNumericFieldNames(9))//' set to 0.')
FrameDivider(FrameDividerNum)%DividerWidth=0.0d0
ENDIF
! Prevent InsideSillDepth < InsideReveal
IF(FrameDivider(FrameDividerNum)%InsideSillDepth < FrameDivider(FrameDividerNum)%InsideReveal) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': In FrameAndDivider '//TRIM(FrameDivider(FrameDividerNum)%Name)// &
' '//TRIM(cNumericFieldNames(20))//' is less than '//TRIM(cNumericFieldNames(22))//'; it will be set to '// &
TRIM(cNumericFieldNames(22))//'.')
FrameDivider(FrameDividerNum)%InsideSillDepth = FrameDivider(FrameDividerNum)%InsideReveal
END IF
! ! Warn if InsideSillDepth OR InsideReveal > 0.2meters to warn of inaccuracies
! IF(FrameDivider(FrameDividerNum)%InsideSillDepth > 0.2d0) THEN
! CALL ShowWarningError(TRIM(CurrentModuleObject)//': In FrameAndDivider '//TRIM(FrameDivider(FrameDividerNum)%Name)// &
! ' '//TRIM(cNumericFieldNames(20))//' is greater than 0.2 meters, which could cause inaccuracies in zone cooling energy.')
! END IF
! IF(FrameDivider(FrameDividerNum)%InsideReveal > 0.2d0) THEN
! CALL ShowWarningError(TRIM(CurrentModuleObject)//': In FrameAndDivider '//TRIM(FrameDivider(FrameDividerNum)%Name)// &
! ' '//TRIM(cNumericFieldNames(22))//' is greater than 0.2 meters, which could cause inaccuracies in zone cooling energy.')
! END IF
END DO
RETURN
END SUBROUTINE GetFrameAndDividerData