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) | :: | TotOverhangs | |||
integer, | intent(in) | :: | TotOverhangsProjection | |||
integer, | intent(in) | :: | TotFins | |||
integer, | intent(in) | :: | TotFinsProjection |
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 GetSimpleShdSurfaceData(ErrorsFound,SurfNum,TotOverhangs,TotOverhangsProjection,TotFins,TotFinsProjection)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN January 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Get simple overhang and fin descriptions.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, VerifyName, GetObjectDefMaxArgs
USE General, ONLY: TrimSigDigits,RoundSigDigits
USE DataReportingFlags
USE Vectors
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) :: TotOverhangs ! Number of Overhangs to obtain
INTEGER, INTENT(IN) :: TotOverhangsProjection ! Number of Overhangs (projection) to obtain
INTEGER, INTENT(IN) :: TotFins ! Number of Fins to obtain
INTEGER, INTENT(IN) :: TotFinsProjection ! Number of Fins (projection) to obtain
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER, DIMENSION(4) :: cModuleObjects= &
(/'Shading:Overhang ', &
'Shading:Overhang:Projection', &
'Shading:Fin ', &
'Shading:Fin:Projection '/)
CHARACTER(len=*), PARAMETER :: dfmt='(A,3(2x,f6.2))'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Item
INTEGER :: ItemsToGet
INTEGER :: Loop
INTEGER :: NumAlphas
INTEGER :: NumNumbers
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: Found ! For matching base surfaces
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
REAL(r64) :: Depth
REAL(r64) :: Length
REAL(r64) :: Xp
REAL(r64) :: Yp
REAL(r64) :: Zp
REAL(r64) :: XLLC
REAL(r64) :: YLLC
INTEGER :: BaseSurfNum
REAL(r64) :: TiltAngle
LOGICAL :: MakeFin
IF ((TotOverhangs+TotOverhangsProjection+TotFins+TotFinsProjection) > 0 .and. SolarDistribution == MinimalShadowing) THEN
CALL ShowWarningError('Shading effects of Fins and Overhangs are ignored when Solar Distribution = MinimalShadowing')
ENDIF
DO Item=1,4
cCurrentModuleObject=cModuleObjects(Item)
IF (Item == 1) THEN
ItemsToGet=TotOverhangs
ELSEIF (Item == 2) THEN
ItemsToGet=TotOverhangsProjection
ELSEIF (Item == 3) THEN
ItemsToGet=TotFins
ELSE ! ! (Item == 4) THEN
ItemsToGet=TotFinsProjection
ENDIF
DO Loop=1,ItemsToGet
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.
! this object references a window or door....
Found=FindIteminList(cAlphaArgs(2),SurfaceTmp%Name,TotSurfaces)
IF (Found > 0) THEN
BaseSurfNum=SurfaceTmp(Found)%BaseSurf
SurfaceTmp(SurfNum)%BaseSurfName=SurfaceTmp(Found)%BaseSurfName
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.
CYCLE
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
SurfaceTmp(SurfNum)%SchedShadowSurfIndex=0
!===== Overhang =====
IF (Item < 3) THEN
! Found is the surface window or door.
! N1, \field Height above Window or Door
! \units m
! N2, \field Tilt Angle from Window/Door
! \units deg
! \default 90
! \minimum 0
! \maximum 180
! N3, \field Left extension from Window/Door Width
! \units m
! N4, \field Right extension from Window/Door Width
! \note N3 + N4 + Window/Door Width is Overhang Length
! \units m
! N5; \field Depth
! \units m
! for projection option:
! N5; \field Depth as Fraction of Window/Door Height
! \units m
Length=rNumericArgs(3)+rNumericArgs(4)+SurfaceTmp(Found)%Width
IF (Item == 1) THEN
Depth=rNumericArgs(5)
ELSEIF (Item == 2) THEN
Depth=rNumericArgs(5)*SurfaceTmp(Found)%Height
ENDIF
IF (Length*Depth <= 0.0d0) THEN
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", illegal surface area=['// &
trim(RoundSigDigits(Length*Depth,2))//']. Surface will NOT be entered.')
CYCLE
ENDIF
TiltAngle=SurfaceTmp(Found)%Tilt+rNumericArgs(2)
SurfaceTmp(SurfNum)%Tilt=TiltAngle
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(Found)%Azimuth
! Make it relative to surface origin.....
Xp=SurfaceTmp(Found)%Vertex(2)%x-SurfaceTmp(BaseSurfNum)%Vertex(2)%x
Yp=SurfaceTmp(Found)%Vertex(2)%y-SurfaceTmp(BaseSurfNum)%Vertex(2)%y
Zp=SurfaceTmp(Found)%Vertex(2)%z-SurfaceTmp(BaseSurfNum)%Vertex(2)%z
XLLC=-Xp*SurfaceTmp(BaseSurfNum)%CosAzim+Yp*SurfaceTmp(BaseSurfNum)%SinAzim
YLLC=-Xp*SurfaceTmp(BaseSurfNum)%SinAzim*SurfaceTmp(BaseSurfNum)%CosTilt- &
Yp*SurfaceTmp(BaseSurfNum)%CosAzim*SurfaceTmp(BaseSurfNum)%CosTilt+Zp*SurfaceTmp(BaseSurfNum)%SinTilt
SurfaceTmp(SurfNum)%Sides=4
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
CALL MakeRelativeRectangularVertices(BaseSurfNum,SurfNum, &
XLLC-rNumericArgs(3),YLLC+SurfaceTmp(Found)%Height+rNumericArgs(1),Length,Depth)
! Reset surface to be "detached"
! SurfaceTmp(SurfNum)%BaseSurfName=' '
! SurfaceTmp(SurfNum)%ZoneName=' '
SurfaceTmp(SurfNum)%BaseSurf=0
SurfaceTmp(SurfNum)%Zone=0
! and mirror
IF (MakeMirroredAttachedShading) THEN
CALL MakeMirrorSurface(SurfNum)
END IF
ELSE ! Fins
!===== Fins =====
!===== Left Fin =====
! N1, \field Left Extension from Window/Door
! \units m
! N2, \field Left Distance Above Top of Window
! \units m
! N3, \field Left Distance Below Bottom of Window
! \units m
! \note N2 + N3 + height of Window/Door is height of Fin
! N4, \field Left Tilt Angle from Window/Door
! \units deg
! \default 90
! \minimum 0
! \maximum 180
! N5, \field Left Depth
! \units m
! for projection option:
! N5, \field Left Depth as Fraction of Window/Door Width
! \units m
SurfaceTmp(SurfNum)%Name=TRIM(SurfaceTmp(SurfNum)%Name)//' Left'
Length=rNumericArgs(2)+rNumericArgs(3)+SurfaceTmp(Found)%Height
IF (Item == 3) THEN
Depth=rNumericArgs(5)
ELSEIF (Item == 4) THEN
Depth=rNumericArgs(5)*SurfaceTmp(Found)%Width
ENDIF
MakeFin=.true.
IF (Length*Depth <= 0.0d0) THEN
CALL ShowWarningError(trim(cCurrentModuleObject)//'=Left Fin of "'//trim(cAlphaArgs(1))// &
'", illegal surface area=['// &
trim(RoundSigDigits(Length*Depth,2))//']. Surface will NOT be entered.')
MakeFin=.false.
ENDIF
IF (MakeFin) THEN
TiltAngle=SurfaceTmp(Found)%Tilt
SurfaceTmp(SurfNum)%Tilt=TiltAngle
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(Found)%Azimuth-(180.0d0-rNumericArgs(4))
! Make it relative to surface origin.....
Xp=SurfaceTmp(Found)%Vertex(2)%x-SurfaceTmp(BaseSurfNum)%Vertex(2)%x
Yp=SurfaceTmp(Found)%Vertex(2)%y-SurfaceTmp(BaseSurfNum)%Vertex(2)%y
Zp=SurfaceTmp(Found)%Vertex(2)%z-SurfaceTmp(BaseSurfNum)%Vertex(2)%z
XLLC=-Xp*SurfaceTmp(BaseSurfNum)%CosAzim+Yp*SurfaceTmp(BaseSurfNum)%SinAzim
YLLC=-Xp*SurfaceTmp(BaseSurfNum)%SinAzim*SurfaceTmp(BaseSurfNum)%CosTilt- &
Yp*SurfaceTmp(BaseSurfNum)%CosAzim*SurfaceTmp(BaseSurfNum)%CosTilt+Zp*SurfaceTmp(BaseSurfNum)%SinTilt
SurfaceTmp(SurfNum)%CosAzim=COS(SurfaceTmp(SurfNum)%Azimuth*DegToRadians)
SurfaceTmp(SurfNum)%SinAzim=SIN(SurfaceTmp(SurfNum)%Azimuth*DegToRadians)
SurfaceTmp(SurfNum)%CosTilt=COS(SurfaceTmp(SurfNum)%Tilt*DegToRadians)
SurfaceTmp(SurfNum)%SinTilt=SIN(SurfaceTmp(SurfNum)%Tilt*DegToRadians)
SurfaceTmp(SurfNum)%Sides=4
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
CALL MakeRelativeRectangularVertices(BaseSurfNum,SurfNum, &
XLLC-rNumericArgs(1),YLLC-rNumericArgs(3),-Depth,Length)
! Reset surface to be "detached"
! SurfaceTmp(SurfNum)%BaseSurfName=' '
! SurfaceTmp(SurfNum)%ZoneName=' '
SurfaceTmp(SurfNum)%BaseSurf=0
SurfaceTmp(SurfNum)%Zone=0
! and mirror
IF (MakeMirroredAttachedShading) THEN
CALL MakeMirrorSurface(SurfNum)
END IF
ELSE
SurfNum=SurfNum-1
ENDIF
!===== Right Fin =====
! N6, \field Right Extension from Window/Door
! \units m
! N7, \field Right Distance Above Top of Window
! \units m
! N8, \field Right Distance Below Bottom of Window
! \note N7 + N8 + height of Window/Door is height of Fin
! \units m
! N9, \field Right Tilt Angle from Window/Door
! \units deg
! \default 90
! \minimum 0
! \maximum 180
! N10; \field Right Depth
! \units m
! for projection option:
! N10; \field Right Depth as Fraction of Window/Door Width
! \units m
SurfNum=SurfNum+1
SurfaceTmp(SurfNum)%Name = TRIM(cAlphaArgs(1))//' Right' ! Set the Surface Name in the Derived Type
SurfaceTmp(SurfNum)%Class= SurfaceClass_Shading
SurfaceTmp(SurfNum)%HeatTransSurf=.false.
BaseSurfNum=SurfaceTmp(Found)%BaseSurf
SurfaceTmp(SurfNum)%BaseSurfName=SurfaceTmp(Found)%BaseSurfName
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
SurfaceTmp(SurfNum)%SchedShadowSurfIndex=0
Length=rNumericArgs(7)+rNumericArgs(8)+SurfaceTmp(Found)%Height
IF (Item == 3) THEN
Depth=rNumericArgs(10)
ELSEIF (Item == 4) THEN
Depth=rNumericArgs(10)*SurfaceTmp(Found)%Width
ENDIF
MakeFin=.true.
IF (Length*Depth <= 0.0d0) THEN
CALL ShowWarningError(trim(cCurrentModuleObject)//'=Right Fin of "'//trim(cAlphaArgs(1))// &
'", illegal surface area=['// &
trim(RoundSigDigits(Length*Depth,2))//']. Surface will NOT be entered.')
MakeFin=.false.
ENDIF
IF (MakeFin) THEN
! Make it relative to surface origin.....
Xp=SurfaceTmp(Found)%Vertex(2)%x-SurfaceTmp(BaseSurfNum)%Vertex(2)%x
Yp=SurfaceTmp(Found)%Vertex(2)%y-SurfaceTmp(BaseSurfNum)%Vertex(2)%y
Zp=SurfaceTmp(Found)%Vertex(2)%z-SurfaceTmp(BaseSurfNum)%Vertex(2)%z
XLLC=-Xp*SurfaceTmp(BaseSurfNum)%CosAzim+Yp*SurfaceTmp(BaseSurfNum)%SinAzim
YLLC=-Xp*SurfaceTmp(BaseSurfNum)%SinAzim*SurfaceTmp(BaseSurfNum)%CosTilt- &
Yp*SurfaceTmp(BaseSurfNum)%CosAzim*SurfaceTmp(BaseSurfNum)%CosTilt+Zp*SurfaceTmp(BaseSurfNum)%SinTilt
TiltAngle=SurfaceTmp(Found)%Tilt
SurfaceTmp(SurfNum)%Tilt=TiltAngle
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(Found)%Azimuth-(180.0-rNumericArgs(9))
SurfaceTmp(SurfNum)%CosAzim=COS(SurfaceTmp(SurfNum)%Azimuth*DegToRadians)
SurfaceTmp(SurfNum)%SinAzim=SIN(SurfaceTmp(SurfNum)%Azimuth*DegToRadians)
SurfaceTmp(SurfNum)%CosTilt=COS(SurfaceTmp(SurfNum)%Tilt*DegToRadians)
SurfaceTmp(SurfNum)%SinTilt=SIN(SurfaceTmp(SurfNum)%Tilt*DegToRadians)
SurfaceTmp(SurfNum)%Sides=4
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
CALL MakeRelativeRectangularVertices(BaseSurfNum,SurfNum, &
XLLC+SurfaceTmp(Found)%Width+rNumericArgs(6),YLLC-rNumericArgs(8),-Depth,Length)
! Reset surface to be "detached"
! SurfaceTmp(SurfNum)%BaseSurfName=' '
! SurfaceTmp(SurfNum)%ZoneName=' '
SurfaceTmp(SurfNum)%BaseSurf=0
SurfaceTmp(SurfNum)%Zone=0
! and mirror
IF (MakeMirroredAttachedShading) THEN
CALL MakeMirrorSurface(SurfNum)
END IF
ELSE
SurfNum=SurfNum-1
ENDIF
ENDIF
ENDDO
ENDDO
RETURN
END SUBROUTINE GetSimpleShdSurfaceData