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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | SurfNum | |||
integer, | intent(in) | :: | NSides |
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 TransformVertsByAspect(SurfNum,NSides)
! SUBROUTINE INFORMATION:
! AUTHOR Brent T Griffith
! DATE WRITTEN April 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Alter input for surface geometry
! Optimizing building design for energy can involve
! altering building geometry. Rather than assemble routines to transform
! geometry through pre-processing on input, it may be simpler to change
! vertices within EnergyPlus since it already reads the data from the input
! file and there would no longer be a need to rewrite the text data.
! This is essentially a crude hack to allow adjusting geometry with
! a single parameter...
!
! METHODOLOGY EMPLOYED:
! once vertices have been converted to WCS, change them to reflect a different aspect
! ratio for the entire building based on user input.
! This routine is called once for each surface by subroutine GetVertices
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SurfNum ! Current surface number
INTEGER, INTENT(IN) :: NSides ! Number of sides to figure
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='GeometryTransform'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength), DIMENSION(1) :: cAlphas
REAL(r64), DIMENSION(2) :: rNumerics
INTEGER :: NAlphas
INTEGER :: NNum
INTEGER :: IOSTAT
REAL(r64),SAVE :: OldAspectRatio
REAL(r64),SAVE :: NewAspectRatio
Logical, save :: firstTime = .true.
Logical, save :: noTransform = .true.
CHARACTER(len=2),save :: transformPlane
INTEGER :: N
REAL(r64) :: Xo, XnoRot, Xtrans
REAL(r64) :: Yo, YnoRot, Ytrans
!begin execution
!get user input...
IF (firstTime) then
IF (GetNumObjectsFound(CurrentModuleObject) == 1) then
CALL GetObjectItem(CurrentModuleObject,1,cAlphas,NAlphas,rNumerics,NNum,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
OldAspectRatio = rNumerics(1)
NewAspectRatio = rNumerics(2)
transformPlane = cAlphas(1)
IF (transformPlane /= 'XY') then
CALL ShowWarningError(CurrentModuleObject//': invalid '//TRIM(cAlphaFieldNames(1))// &
'="'//TRIM(cAlphas(1))//'...ignored.')
ENDIF
firstTime = .false.
noTransform = .false.
AspectTransform = .true.
IF (WorldCoordSystem) THEN
CALL ShowWarningError(CurrentModuleObject//': must use Relative Coordinate System. '// &
'Transform request ignored.')
noTransform=.true.
AspectTransform=.false.
ENDIF
ELSE
firstTime = .false.
Endif
endif
If (noTransform) return
!check surface type.
IF (.not. SurfaceTmp(SurfNum)%HeatTransSurf) THEN
! Site Shading do not get transformed.
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Detached_F) return
ENDIF
!testing method of transforming x and y coordinates as follows
! this works if not rotated wrt north axis ... but if it is, then trouble
! try to first derotate it , transform by aspect and then rotate back.
DO N=1,NSides
Xo = SurfaceTmp(SurfNum)%Vertex(N)%X ! world coordinates.... shifted by relative north angle...
Yo = SurfaceTmp(SurfNum)%Vertex(N)%Y
! next derotate the building
XnoRot=Xo * CosBldgRelNorth + Yo * SinBldgRelNorth
YnoRot=Yo * CosBldgRelNorth - Xo * SinBldgRelNorth
! translate
Xtrans = XnoRot * SQRT(NewAspectRatio/OldAspectRatio)
Ytrans = YnoRot * SQRT(OldAspectRatio/NewAspectRatio)
! rerotate
SurfaceTmp(SurfNum)%Vertex(N)%X = Xtrans * CosBldgRelNorth - Ytrans * SinBldgRelNorth
SurfaceTmp(SurfNum)%Vertex(N)%Y = Xtrans * SinBldgRelNorth + Ytrans * CosBldgRelNorth
ENDDO
Return
END SUBROUTINE TransformVertsByAspect