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 | |||
integer, | intent(inout) | :: | SurfNum | |||
integer, | intent(in) | :: | TotShdSubs |
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 GetAttShdSurfaceData(ErrorsFound,SurfNum,TotShdSubs)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN May 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the HeatTransfer Surface Data,
! checks it for errors, etc.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Attached Shading Surface Definition
!Surface:Shading:Attached,
! \memo used For fins, overhangs, elements that shade the building, are attached to the building
! \memo but are not part of the heat transfer calculations
! A1 , \field User Supplied Surface Name
! \required-field
! \type alpha
! \reference AttachedShadingSurfNames
! A2 , \field Base Surface Name
! \required-field
! \type object-list
! \object-list SurfaceNames
! A3, \field TransSchedShadowSurf
! \note Transmittance schedule for the shading device, defaults to zero (always opaque)
! \type object-list
! \object-list ScheduleNames
! N1 , \field Number of Surface Vertex Groups -- Number of (X,Y,Z) groups in this surface
! \required-field
! \note currently limited 3 or 4, later?
! \minimum 3
! \maximum 4
! \note vertices are given in SurfaceGeometry coordinates -- if relative, all surface coordinates
! \note are "relative" to the Zone Origin. if WCS, then building and zone origins are used
! \note for some internal calculations, but all coordinates are given in an "absolute" system.
! N2, \field Vertex 1 X-coordinate
! \units m
! \type real
! N3-13; as indicated by the N2 value
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, VerifyName, GetObjectDefMaxArgs
USE ScheduleManager, ONLY: GetScheduleIndex,CheckScheduleValueMinMax,GetScheduleMinValue,GetScheduleMaxValue
USE General, ONLY: TrimSigDigits
USE DataReportingFlags
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Error flag indicator (true if errors found)
INTEGER, INTENT(INOUT) :: SurfNum ! Count of Current SurfaceNumber
INTEGER, INTENT(IN) :: TotShdSubs ! Number of Attached Shading SubSurfaces to obtain
! 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
INTEGER :: NumAlphas ! Number of alpha names being passed
INTEGER :: NumNumbers ! Number of properties being passed
INTEGER :: Found ! For matching interzone surfaces
INTEGER :: Loop
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
REAL(r64) :: SchedMinValue
REAL(r64) :: SchedMaxValue
IF (TotShdSubs > 0 .and. SolarDistribution == MinimalShadowing) THEN
CALL ShowWarningError('Shading effects of Fins and Overhangs are ignored when Solar Distribution = MinimalShadowing')
ENDIF
cCurrentModuleObject='Shading:Zone:Detailed'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,Loop,NumAlphas,NumNumbers)
IF (NumAlphas /= 3) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Object Definition indicates '// &
'not = 3 Alpha Objects, Number Indicated='// &
TRIM(TrimSigDigits(NumAlphas)))
ErrorsFound=.true.
ENDIF
DO Loop=1,TotShdSubs
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNumbers,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),SurfaceTmp%Name,SurfNum,ErrorInName,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...each surface name must not duplicate other surface names (of any type)')
ErrorsFound=.true.
CYCLE
ENDIF
SurfNum=SurfNum+1
SurfaceTmp(SurfNum)%Name = cAlphaArgs(1) ! Set the Surface Name in the Derived Type
SurfaceTmp(SurfNum)%Class= SurfaceClass_Shading
SurfaceTmp(SurfNum)%HeatTransSurf=.false.
SurfaceTmp(SurfNum)%BaseSurfName=cAlphaArgs(2)
! The subsurface inherits properties from the base surface
! Exterior conditions, Zone, etc.
! We can figure out the base surface though, because they've all been entered
Found=FindIteminList(SurfaceTmp(SurfNum)%BaseSurfName,SurfaceTmp%Name,TotSurfaces)
IF (Found > 0) THEN
!SurfaceTmp(SurfNum)%BaseSurf=Found
SurfaceTmp(SurfNum)%ExtBoundCond=SurfaceTmp(Found)%ExtBoundCond
SurfaceTmp(SurfNum)%ExtSolar=SurfaceTmp(Found)%ExtSolar
SurfaceTmp(SurfNum)%ExtWind=SurfaceTmp(Found)%ExtWind
SurfaceTmp(SurfNum)%Zone=SurfaceTmp(Found)%Zone ! Necessary to do relative coordinates in GetVertices below
SurfaceTmp(SurfNum)%ZoneName=SurfaceTmp(Found)%ZoneName ! Necessary to have surface drawn in OutputReports
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2)))
ErrorsFound=.true.
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnenteredAdjacentZoneSurface) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('...trying to attach a shading device to an interzone surface.')
ErrorsFound=.true.
SurfaceTmp(SurfNum)%ExtBoundCond = ExternalEnvironment ! reset so program won't crash during "add surfaces"
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('...trying to attach a shading device to an interior surface.')
ErrorsFound=.true.
SurfaceTmp(SurfNum)%ExtBoundCond = ExternalEnvironment ! reset so program won't crash during "add surfaces"
ENDIF
IF (.not. lAlphaFieldBlanks(3)) THEN
SurfaceTmp(SurfNum)%SchedShadowSurfIndex = GetScheduleIndex(cAlphaArgs(3))
IF (SurfaceTmp(SurfNum)%SchedShadowSurfIndex == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cAlphaFieldNames(3))//' not found="'//TRIM(cAlphaArgs(3)))
ErrorsFound=.true.
ENDIF
ELSE
SurfaceTmp(SurfNum)%SchedShadowSurfIndex=0
ENDIF
IF (SurfaceTmp(SurfNum)%SchedShadowSurfIndex /= 0) THEN
IF (.not. CheckScheduleValueMinMax(SurfaceTmp(SurfNum)%SchedShadowSurfIndex,'>=',0.0d0,'<=',1.0d0)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))// &
'", values not in range [0,1].')
ErrorsFound=.true.
ENDIF
SchedMinValue=GetScheduleMinValue(SurfaceTmp(SurfNum)%SchedShadowSurfIndex)
SurfaceTmp(SurfNum)%SchedMinValue=SchedMinValue
SchedMaxValue=GetScheduleMaxValue(SurfaceTmp(SurfNum)%SchedShadowSurfIndex)
IF (SchedMinValue == 1.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", is always transparent.')
SurfaceTmp(SurfNum)%IsTransparent=.true.
ENDIF
IF (SchedMinValue < 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", has schedule values < 0.')
CALL ShowContinueError('...Schedule values < 0 have no meaning for shading elements.')
ENDIF
IF (SchedMaxValue > 1.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))// &
'", has schedule values > 1.')
CALL ShowContinueError('...Schedule values > 1 have no meaning for shading elements.')
ENDIF
IF (ABS(SchedMinValue-SchedMaxValue) > 1.0d-6) THEN
SurfaceTmp(SurfNum)%ShadowSurfSchedVaries=.true.
ShadingTransmittanceVaries=.true.
ENDIF
ENDIF
IF (lNumericFieldBlanks(1) .or. rNumericArgs(1) == AutoCalculate) THEN
rNumericArgs(1)=(NumNumbers-1)/3
SurfaceTmp(SurfNum)%Sides=rNumericArgs(1)
IF (MOD(NumNumbers-1,3) /= 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cNumericFieldNames(1))// &
' not even multiple of 3. Will read in '// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides)))
ENDIF
IF (rNumericArgs(1) < 3) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cNumericFieldNames(1))//' (autocalculate) must be >= 3. Only '// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides))//' provided.')
ErrorsFound=.true.
CYCLE
ENDIF
ELSE
SurfaceTmp(SurfNum)%Sides=rNumericArgs(1)
ENDIF
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
CALL GetVertices(SurfNum,SurfaceTmp(SurfNum)%Sides,rNumericArgs(2:))
CALL CheckConvexity(SurfNum,SurfaceTmp(SurfNum)%Sides)
! IF (SurfaceTmp(SurfNum)%Sides == 3) THEN
! CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
! ' should not be triangular.')
! CALL ShowContinueError('...Check results carefully.')
! ErrorsFound=.true.
! ENDIF
! Reset surface to be "detached"
SurfaceTmp(SurfNum)%BaseSurf=0
! SurfaceTmp(SurfNum)%BaseSurfName=' '
SurfaceTmp(SurfNum)%Zone=0
!SurfaceTmp(SurfNum)%ZoneName=' '
IF (MakeMirroredAttachedShading) THEN
CALL MakeMirrorSurface(SurfNum)
END IF
ENDDO
RETURN
END SUBROUTINE GetAttShdSurfaceData