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 | ||
---|---|---|---|---|---|---|
character(len=*) | :: | PolygonAction | ||||
character(len=*) | :: | ColorScheme |
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 VRMLOut(PolygonAction,ColorScheme)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN August 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine produces a file of VRML output for the surfaces.
! METHODOLOGY EMPLOYED:
! Use the surface absolute coordinate information to produce
! lines.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataHeatBalance, ONLY: BuildingName,Zone
USE DataSurfaces
USE DataDaylighting, ONLY: ZoneDaylight
USE DataGlobals, ONLY: DegToRadians,NumOfZones
USE DataInterfaces, ONLY: ShowWarningError, ShowContinueError, ShowFatalError
USE DataStringGlobals, ONLY: VerString
USE DXFEarClipping
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*) :: PolygonAction
CHARACTER(len=*) :: ColorScheme
! SUBROUTINE PARAMETER DEFINITIONS:
character(len=*), parameter, dimension(7) :: colorstring= &
(/'WALL ', &
'WINDOW ', &
'FIXEDSHADE', &
'SUBSHADE ', &
'ROOF ', &
'FLOOR ', &
'BLDGSHADE '/)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
integer unit ! Unit number on which to write file
integer surf ! Loop variable for surfaces
integer vert ! Loop counter
integer,external :: getnewunitnumber ! External function for a new unit number
integer colorindex ! color index by surface type
! REAL(r64) minx ! minimum x in surface data
! REAL(r64) miny ! minimum y in surface data
! REAL(r64) minz ! minimum z in surface data (for polygon output)
integer zones ! loop counter for zone loop
character(len=25) zonenum
character(len=MaxNameLength) TempZoneName
integer pos
character(len=25) ShadeType
logical :: ThickPolyline=.false.
logical :: RegularPolyline=.false.
character(len=5) :: PolylineWidth=' 0.55'
logical :: TriangulateFace=.false.
integer :: ntri
integer :: svert
type (dTriangle), allocatable, dimension(:) :: mytriangles
integer :: vv0
integer :: vv1
integer :: vv2
character(len=25) :: csurfnumber
character(len=25) :: csidenumber
integer write_stat
IF (PolygonAction == 'TRIANGULATE3DFACE' .or. PolygonAction == 'TRIANGULATE') THEN
TriangulateFace=.true.
ELSEIF (PolygonAction == 'THICKPOLYLINE' .or. PolygonAction == ' ') THEN
ThickPolyline=.true.
ELSEIF (PolygonAction == 'REGULARPOLYLINE') THEN
RegularPolyline=.true.
PolylineWidth=' 0'
ELSE
CALL ShowWarningError('VRMLOut: Illegal key specified for Surfaces with > 4 sides='//TRIM(PolygonAction))
CALL ShowContinueError('"TRIANGULATE 3DFACE" will be used for any surfaces with > 4 sides.')
TriangulateFace=.true.
ENDIF
if (totsurfaces > 0 .and. .not. allocated(surface)) then
! no error needed, probably in end processing, just return
return
endif
unit=getnewunitnumber()
open(unit,file='eplusout.wrl', Action='write', iostat=write_stat)
if (write_stat /= 0) then
CALL ShowFatalError('VRMLOut: Could not open file "eplusout.wrl" for output (write).')
endif
write(unit,702) ! Beginning
702 format('#VRML V2.0 utf8')
if (ColorScheme == ' ') then
write(unit,707) TRIM(BuildingName),TRIM(VerString),'Default' ! World Info
else
write(unit,707) TRIM(BuildingName),TRIM(VerString),TRIM(ColorScheme) ! World Info
endif
707 format('WorldInfo {',/,3X,'title "Building - ',A,'"',/, &
3X,'info ["EnergyPlus Program Version ',A,'"]',/, &
3X,'info ["Surface Color Scheme ',A,'"]',/, &
'}')
write(unit,710) '# Zone Names'
do zones=1,NumOfZones
write(zonenum,*) zones
zonenum=adjustl(zonenum)
TempZoneName=Zone(Zones)%Name
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),' ')
DO WHILE (pos /= 0)
TempZoneName(pos:pos)='_'
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),' ')
END DO
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),':')
DO WHILE (pos /= 0)
TempZoneName(pos:pos)='_'
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),':')
END DO
write(unit,710) '# Zone='//trim(zonenum)//':'//trim(TempZoneName)
enddo
! Define the colors:
800 Format ('Shape {',/,'appearance DEF ',A,' Appearance {',/, &
'material Material { diffuseColor ',A,' }',/,'}',/,'}')
write(unit,800) 'FLOOR','0.502 0.502 0.502'
write(unit,800) 'ROOF','1 1 0'
write(unit,800) 'WALL','0 1 0'
write(unit,800) 'WINDOW','0 1 1'
write(unit,800) 'DOOR','0 1 1'
write(unit,800) 'GLASSDOOR','0 1 1'
write(unit,800) 'FIXEDSHADE','1 0 1'
write(unit,800) 'BLDGSHADE','0 0 1'
write(unit,800) 'SUBSHADE','1 0 1'
write(unit,800) 'BACKCOLOR','0.502 0.502 0.784'
801 Format('Shape {',/,'appearance USE ',A,/, &
'geometry IndexedFaceSet {',/, &
'solid TRUE',/, &
'coord DEF ',A,' Coordinate {',/, &
'point [')
802 Format(F15.5,1X,F15.5,1X,F15.5,',')
803 Format(']',/,'}',/,'coordIndex [')
804 Format(A)
805 Format(']',/,'ccw TRUE',/,'solid TRUE',/,'}',/,'}')
! Do all detached shading surfaces first
do surf=1,totsurfaces
if (surface(surf)%heattranssurf) CYCLE
if (surface(surf)%class == SurfaceClass_Shading) CYCLE
if (surface(surf)%sides == 0) CYCLE
if (surface(surf)%class .eq. SurfaceClass_Detached_F) colorindex=3
if (surface(surf)%class .eq. SurfaceClass_Detached_B) colorindex=7
if (surface(surf)%class .eq. SurfaceClass_Detached_F) then
ShadeType='Fixed Shading'
write(unit,710) '# Fixed Shading:'//trim(surface(surf)%Name)
elseif (surface(surf)%class .eq. SurfaceClass_Detached_B) then
ShadeType='Building Shading'
write(unit,710) '# Building Shading:'//trim(surface(surf)%Name)
endif
write(csurfnumber,*) surf
csurfnumber=adjustl(csurfnumber)
write(unit,801) trim(colorstring(colorindex)),'Surf'//TRIM(csurfnumber)
write(unit,802) (surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y, &
surface(surf)%vertex(vert)%z,vert=1,surface(surf)%sides)
write(unit,803)
if (surface(surf)%sides <= 4 .or. .not. TriangulateFace) then
do vert=1,surface(surf)%sides
write(csidenumber,*) vert-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
if (vert == surface(surf)%sides) write(unit,804) ' -1'
enddo
write(unit,805)
else ! will be >4 sided polygon with triangulate option
ntri=triangulate(surface(surf)%sides,surface(surf)%vertex,mytriangles,surface(surf)%azimuth, &
surface(surf)%tilt,surface(surf)%name,surface(surf)%class)
do svert=1,ntri
vv0=mytriangles(svert)%vv0
write(csidenumber,*) vv0-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
vv1=mytriangles(svert)%vv1
write(csidenumber,*) vv1-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
vv2=mytriangles(svert)%vv2
write(csidenumber,*) vv2-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
write(unit,804) ' -1'
enddo
write(unit,805)
deallocate(mytriangles)
endif
enddo
!
! ! now do zone surfaces, by zone
do zones=1,NumOfZones
TempZoneName=Zone(Zones)%Name
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),' ')
DO WHILE (pos /= 0)
TempZoneName(pos:pos)='_'
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),' ')
END DO
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),':')
DO WHILE (pos /= 0)
TempZoneName(pos:pos)='_'
pos=INDEX(TempZoneName(1:LEN_TRIM(TempZoneName)),':')
END DO
do surf=max(zone(zones)%surfacefirst,1),zone(zones)%surfacelast
if (surface(surf)%sides == 0) CYCLE
if (surface(surf)%class .eq. SurfaceClass_IntMass) CYCLE
if (surface(surf)%class .eq. SurfaceClass_Wall) colorindex=1
if (surface(surf)%class .eq. SurfaceClass_Roof) colorindex=5
if (surface(surf)%class .eq. SurfaceClass_TDD_Dome) colorindex=2
if (surface(surf)%class .eq. SurfaceClass_Floor) colorindex=6
if (surface(surf)%class .eq. SurfaceClass_Window) colorindex=2
if (surface(surf)%class .eq. SurfaceClass_Door) colorindex=2
!
write(csurfnumber,*) surf
csurfnumber=adjustl(csurfnumber)
write(unit,710) '# '//trim(surface(surf)%ZoneName)//':'//trim(surface(surf)%Name)
write(unit,801) trim(colorstring(colorindex)),'Surf'//TRIM(csurfnumber)
write(unit,802) (surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y, &
surface(surf)%vertex(vert)%z,vert=1,surface(surf)%sides)
write(unit,803)
if (surface(surf)%sides <= 4 .or. .not. TriangulateFace) then
do vert=1,surface(surf)%sides
write(csidenumber,*) vert-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
if (vert == surface(surf)%sides) write(unit,804) ' -1'
enddo
write(unit,805)
else ! will be >4 sided polygon with triangulate option
ntri=triangulate(surface(surf)%sides,surface(surf)%vertex,mytriangles,surface(surf)%azimuth, &
surface(surf)%tilt,surface(surf)%name,surface(surf)%class)
do svert=1,ntri
vv0=mytriangles(svert)%vv0
write(csidenumber,*) vv0-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
vv1=mytriangles(svert)%vv1
write(csidenumber,*) vv1-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
vv2=mytriangles(svert)%vv2
write(csidenumber,*) vv2-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
write(unit,804) ' -1'
enddo
write(unit,805)
deallocate(mytriangles)
endif
enddo
! still have to do shading surfaces for zone
colorindex=4
do surf=1,totsurfaces
! !if (surface(surf)%heattranssurf) CYCLE ! Shading with a construction is allowed to be HT surf for daylighting shelves
if (surface(surf)%class .ne. SurfaceClass_Shading) CYCLE
if (surface(surf)%zonename /= zone(zones)%Name) CYCLE
if (surface(surf)%sides == 0) CYCLE
write(unit,710) '# '//trim(surface(surf)%ZoneName)//':'//trim(surface(surf)%Name)
write(unit,801) trim(colorstring(colorindex)),'Surf'//TRIM(csurfnumber)
write(unit,802) (surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y, &
surface(surf)%vertex(vert)%z,vert=1,surface(surf)%sides)
write(unit,803)
if (surface(surf)%sides <= 4 .or. .not. TriangulateFace) then
do vert=1,surface(surf)%sides
write(csidenumber,*) vert-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
if (vert == surface(surf)%sides) write(unit,804) ' -1'
enddo
write(unit,805)
else ! will be >4 sided polygon with triangulate option
ntri=triangulate(surface(surf)%sides,surface(surf)%vertex,mytriangles,surface(surf)%azimuth, &
surface(surf)%tilt,surface(surf)%name,surface(surf)%class)
do svert=1,ntri
vv0=mytriangles(svert)%vv0
write(csidenumber,*) vv0-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
vv1=mytriangles(svert)%vv1
write(csidenumber,*) vv1-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
vv2=mytriangles(svert)%vv2
write(csidenumber,*) vv2-1
csidenumber=adjustl(csidenumber)
write(unit,804,advance='No') ' '//trim(csidenumber)
write(unit,804) ' -1'
enddo
write(unit,805)
deallocate(mytriangles)
endif
enddo
enddo
! vrml does not have daylighting reference points included
710 format(A)
close(unit)
return
END SUBROUTINE VRMLOut