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=*), | intent(in) | :: | 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.
SUBROUTINE DXFOutLines(ColorScheme)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN August 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine produces a points file of lines in 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 DataSurfaceColors
USE DataDaylighting, ONLY: ZoneDaylight
USE DataGlobals, ONLY: DegToRadians,NumOfZones
USE DataInterfaces, ONLY: ShowWarningError, ShowContinueError, ShowFatalError
USE DataStringGlobals, ONLY: VerString
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: ColorScheme
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), dimension(4) :: StemX =(/-10.d0,-10.d0,-10.d0,-10.d0/)
REAL(r64), dimension(4) :: StemY =(/3.d0,3.d0,0.d0,0.d0/)
REAL(r64), dimension(4) :: StemZ =(/.1d0,0.d0,0.d0,.1d0/)
REAL(r64), dimension(4) :: Head1X =(/-10.d0,-10.d0,-10.5d0,-10.5d0/)
REAL(r64), dimension(4) :: Head1Y =(/3.d0,3.d0,2.133975d0,2.133975d0/)
REAL(r64), dimension(4) :: Head1Z =(/.1d0,0.d0,0.d0,.1d0/)
REAL(r64), dimension(4) :: Head2X =(/-10.d0,-10.d0,-9.5d0,-9.5d0/)
REAL(r64), dimension(4) :: Head2Y =(/3.d0,3.d0,2.133975d0,2.133975d0/)
REAL(r64), dimension(4) :: Head2Z =(/.1d0,0.d0,0.d0,.1d0/)
REAL(r64), dimension(4) :: NSide1X =(/-10.5d0,-10.5d0,-10.5d0,-10.5d0/)
REAL(r64), dimension(4) :: NSide1Y =(/4.5d0,4.5d0,3.5d0,3.5d0/)
REAL(r64), dimension(4) :: NSide1Z =(/.1d0,0.d0,0.d0,.1d0/)
REAL(r64), dimension(4) :: NSide2X =(/-10.5d0,-10.5d0,-9.5d0,-9.5d0/)
REAL(r64), dimension(4) :: NSide2Y =(/4.5d0,4.5d0,3.5d0,3.5d0/)
REAL(r64), dimension(4) :: NSide2Z =(/.1d0,0.d0,0.d0,.1d0/)
REAL(r64), dimension(4) :: NSide3X =(/-9.5d0,-9.5d0,-9.5d0,-9.5d0/)
REAL(r64), dimension(4) :: NSide3Y =(/4.5d0,4.5d0,3.5d0,3.5d0/)
REAL(r64), dimension(4) :: NSide3Z =(/.1d0,0.d0,0.d0,.1d0/)
! integer, dimension(7) :: colorno=(/3,4,5,6,2,8,9/)
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
!unused character(len=5) :: PolylineWidth=' 0.55'
character(len=25) cSurfNum
integer surfcount
integer sptr
integer refpt
integer curcolorno
integer write_stat
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.dxf', Action='write', iostat=write_stat)
if (write_stat /= 0) then
CALL ShowFatalError('DXFOutLines: Could not open file "eplusout.dxf" for output (write).')
endif
write(unit,702) ! Start of Entities section
702 format(' 0',/,'SECTION',/,' 2',/,'ENTITIES')
write(unit,707) ! Comment
707 format('999',/,'DXF created from EnergyPlus')
write(unit,708) 'Program Version',',',TRIM(VerString)
708 format('999',/,A,A,A)
write(unit,708) 'DXF using Lines',' ',' '
IF (ColorScheme == ' ') THEN
write(unit,708) 'Color Scheme',',','Default'
ELSE
write(unit,708) 'Color Scheme',',',TRIM(ColorScheme)
ENDIF
minx=99999.d0
miny=99999.d0
do surf=1,totsurfaces
if (surface(surf)%class == SurfaceClass_IntMass) CYCLE
do vert=1,surface(surf)%sides
minx=MIN(minx,surface(surf)%vertex(vert)%x)
miny=MIN(miny,surface(surf)%vertex(vert)%y)
enddo
enddo
do vert=1,4
StemX(vert)=StemX(vert)+minx
StemY(vert)=StemY(vert)+miny
Head1X(vert)=Head1X(vert)+minx
Head1Y(vert)=Head1Y(vert)+miny
Head2X(vert)=Head2X(vert)+minx
Head2Y(vert)=Head2Y(vert)+miny
NSide1X(vert)=NSide1X(vert)+minx
NSide1Y(vert)=NSide1Y(vert)+miny
NSide2X(vert)=NSide2X(vert)+minx
NSide2Y(vert)=NSide2Y(vert)+miny
NSide3X(vert)=NSide3X(vert)+minx
NSide3Y(vert)=NSide3Y(vert)+miny
enddo
! This writes "True North" above the Arrow Head
write(unit,710) 'Text - True North'
write(unit,800) DXFcolorno(colorno_Text),StemX(1)-1.0d0 ,StemY(1),StemZ(1)
800 format(' 0',/,'TEXT',/,' 8',/,'1',/,' 6',/,'Continuous',/, &
' 62',/,I3,/,' 10',/,f15.5,/,' 20',/,f15.5,/,' 30',/,f15.5,/, &
' 40',/,' .25',/,' 1',/,'True North',/,' 41',/,' 0.0',/,' 7',/,'MONOTXT',/, &
'210',/,'0.0',/,'220',/,'0.0',/,'230',/,'1.0')
write(unit,710) 'Text - Building Title'
write(unit,801) DXFcolorno(colorno_Text),StemX(1)-4.0d0,StemY(1)-4.0d0 ,StemZ(1),'Building - '//TRIM(BuildingName)
801 format(' 0',/,'TEXT',/,' 8',/,'1',/,' 6',/,'Continuous',/, &
' 62',/,I3,/,' 10',/,f15.5,/,' 20',/,f15.5,/,' 30',/,f15.5,/, &
' 40',/,' .4',/,' 1',/,A,/,' 41',/,' 0.0',/,' 7',/,'MONOTXT',/, &
'210',/,'0.0',/,'220',/,'0.0',/,'230',/,'1.0')
! We want to point the north arrow to true north
write(unit,710) 'North Arrow Stem'
write(unit,703) DXFcolorno(colorno_Text),(StemX(vert),StemY(vert),StemZ(vert),vert=1,4)
write(unit,710) 'North Arrow Head 1'
write(unit,703) DXFcolorno(colorno_Text),(Head1X(vert),Head1Y(vert),Head1Z(vert),vert=1,4)
write(unit,710) 'North Arrow Head 2'
write(unit,703) DXFcolorno(colorno_Text),(Head2X(vert),Head2Y(vert),Head2Z(vert),vert=1,4)
write(unit,710) 'North Arrow Side 1'
write(unit,703) DXFcolorno(colorno_Text),(NSide1X(vert),NSide1Y(vert),NSide1Z(vert),vert=1,4)
write(unit,710) 'North Arrow Side 2'
write(unit,703) DXFcolorno(colorno_Text),(NSide2X(vert),NSide2Y(vert),NSide2Z(vert),vert=1,4)
write(unit,710) 'North Arrow Side 3'
write(unit,703) DXFcolorno(colorno_Text),(NSide3X(vert),NSide3Y(vert),NSide3Z(vert),vert=1,4)
703 format(' 0',/,'3DFACE',/,' 8',/,'1',/,' 62',/,I3,/, &
' 10',/,f15.5,/,' 20',/,f15.5,/,' 30',/,f15.5,/, &
' 11',/,f15.5,/,' 21',/,f15.5,/,' 31',/,f15.5,/, &
' 12',/,f15.5,/,' 22',/,f15.5,/,' 32',/,f15.5,/, &
' 13',/,f15.5,/,' 23',/,f15.5,/,' 33',/,f15.5)
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
! Do all detached shading surfaces first
surfcount=0
do surf=1,totsurfaces
if (surface(surf)%heattranssurf) CYCLE
if (surface(surf)%class == SurfaceClass_Shading) CYCLE
if (surface(surf)%class .eq. SurfaceClass_Detached_F) colorindex=colorno_ShdDetFix
if (surface(surf)%class .eq. SurfaceClass_Detached_B) colorindex=colorno_ShdDetBldg
if (surface(surf)%isPV) colorindex=colorno_PV
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
surfcount=surfcount+1
write(cSurfNum,*) surfcount
cSurfNum=adjustl(cSurfNum)
ShadeType=TRIM(ShadeType)//'_'//TRIM(cSurfNum)
minz=99999.d0
do vert=1,surface(surf)%sides
minz=MIN(minz,surface(surf)%vertex(vert)%z)
enddo
if (surface(surf)%sides <= 4) then
! write(unit,711) TRIM(ShadeType),colorno(colorindex) !,minz ,TRIM(PolylineWidth),TRIM(PolylineWidth)
do vert=1,surface(surf)%sides
if (vert /= surface(surf)%sides) then
sptr=vert+1
else
sptr=1
endif
write(unit,711) TRIM(ShadeType),DXFcolorno(colorindex) !,minz ,TRIM(PolylineWidth),TRIM(PolylineWidth)
write(unit,712) surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z, &
surface(surf)%vertex(sptr)%x,surface(surf)%vertex(sptr)%y,surface(surf)%vertex(sptr)%z
enddo
else ! polygon
do vert=1,surface(surf)%sides
if (vert /= surface(surf)%sides) then
sptr=vert+1
else
sptr=1
endif
write(unit,711) TRIM(ShadeType),DXFcolorno(colorindex) !,minz ,TRIM(PolylineWidth),TRIM(PolylineWidth)
write(unit,712) surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z, &
surface(surf)%vertex(sptr)%x,surface(surf)%vertex(sptr)%y,surface(surf)%vertex(sptr)%z
enddo
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
surfcount=0
do surf=max(zone(zones)%surfacefirst,1),zone(zones)%surfacelast
if (surface(surf)%class .eq. SurfaceClass_IntMass) CYCLE
if (surface(surf)%class .eq. SurfaceClass_Wall) colorindex=colorno_Wall
if (surface(surf)%class .eq. SurfaceClass_Roof) colorindex=colorno_Roof
if (surface(surf)%class .eq. SurfaceClass_Floor) colorindex=colorno_Floor
if (surface(surf)%class .eq. SurfaceClass_Door) colorindex=colorno_Door
if (surface(surf)%class .eq. SurfaceClass_Window) then
if (surfacewindow(surf)%originalclass .eq. SurfaceClass_Window) colorindex=colorno_Window
if (surfacewindow(surf)%originalclass .eq. SurfaceClass_GlassDoor) colorindex=colorno_GlassDoor
if (surfacewindow(surf)%originalclass .eq. SurfaceClass_TDD_Dome) colorindex=colorno_TDDDome
if (surfacewindow(surf)%originalclass .eq. SurfaceClass_TDD_Diffuser) colorindex=colorno_TDDDiffuser
endif
if (surface(surf)%isPV) colorindex=colorno_PV
surfcount=surfcount+1
surfcount=surfcount+1
write(cSurfNum,*) surfcount
cSurfNum=adjustl(cSurfNum)
write(unit,710) trim(surface(surf)%ZoneName)//':'//trim(surface(surf)%Name)
TempZoneName=TRIM(TempZoneName)//'_'//TRIM(cSurfNum)
minz=99999.d0
do vert=1,surface(surf)%sides
minz=MIN(minz,surface(surf)%vertex(vert)%z)
enddo
if (surface(surf)%sides <= 4) then
do vert=1,surface(surf)%sides
if (vert /= surface(surf)%sides) then
sptr=vert+1
else
sptr=1
endif
write(unit,711) TRIM(TempZoneName),DXFcolorno(colorindex) !,minz,TRIM(PolylineWidth),TRIM(PolylineWidth)
write(unit,712) surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z, &
surface(surf)%vertex(sptr)%x,surface(surf)%vertex(sptr)%y,surface(surf)%vertex(sptr)%z
enddo
else ! polygon
do vert=1,surface(surf)%sides
if (vert /= surface(surf)%sides) then
sptr=vert+1
else
sptr=1
endif
write(unit,711) TRIM(TempZoneName),DXFcolorno(colorindex) !,minz,TRIM(PolylineWidth),TRIM(PolylineWidth)
write(unit,712) surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z, &
surface(surf)%vertex(sptr)%x,surface(surf)%vertex(sptr)%y,surface(surf)%vertex(sptr)%z
enddo
endif
! 715 format(' 0',/,'POLYLINE',/,' 8',/,A,/,' 62',/,I3,/,' 66',/,' 1',/, &
! ' 10',/,' 0.0',/,' 20',/,' 0.0',/,' 30',/,f15.5,/, &
! ' 70',/,' 1',/,' 40',/,A,/,' 41',/,A)
! 716 format(' 0',/'VERTEX',/,' 8',/,A,/, &
! ' 10',/,f15.5,/,' 20',/,f15.5,/,' 30',/,f15.5)
! 717 format(' 0',/'SEQEND',/,' 8',/,A)
enddo
! still have to do shading surfaces for zone
surfcount=0
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
colorindex=colorno_ShdAtt
if (surface(surf)%isPV) colorindex=colorno_PV
surfcount=surfcount+1
write(cSurfNum,*) surfcount
cSurfNum=adjustl(cSurfNum)
write(unit,710) trim(surface(surf)%ZoneName)//':'//trim(surface(surf)%Name)
TempZoneName=TRIM(TempZoneName)//'_'//TRIM(cSurfNum)
minz=99999.d0
do vert=1,surface(surf)%sides
minz=MIN(minz,surface(surf)%vertex(vert)%z)
enddo
if (surface(surf)%sides <= 4) then
do vert=1,surface(surf)%sides
if (vert /= surface(surf)%sides) then
sptr=vert+1
else
sptr=1
endif
write(unit,711) TRIM(TempZoneName),DXFcolorno(colorindex) !,minz,TRIM(PolylineWidth),TRIM(PolylineWidth)
write(unit,712) surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z, &
surface(surf)%vertex(sptr)%x,surface(surf)%vertex(sptr)%y,surface(surf)%vertex(sptr)%z
enddo
else ! polygon attached shading
do vert=1,surface(surf)%sides
if (vert /= surface(surf)%sides) then
sptr=vert+1
else
sptr=1
endif
write(unit,711) TRIM(TempZoneName),DXFcolorno(colorindex) !,minz,TRIM(PolylineWidth),TRIM(PolylineWidth)
write(unit,712) surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z, &
surface(surf)%vertex(sptr)%x,surface(surf)%vertex(sptr)%y,surface(surf)%vertex(sptr)%z
enddo
endif
enddo
enddo
704 format(' 0',/,'3DFACE',/,' 8',/,A,/,' 62',/,I3,/, &
' 10',/,f15.5,/,' 20',/,f15.5,/,' 30',/,f15.5,/, &
' 11',/,f15.5,/,' 21',/,f15.5,/,' 31',/,f15.5,/, &
' 12',/,f15.5,/,' 22',/,f15.5,/,' 32',/,f15.5)
705 format(' 13',/,f15.5,/,' 23',/,f15.5,/,' 33',/,f15.5)
711 format(' 0',/,'LINE',/,' 8',/,A,/,' 62',/,I3)
712 format(' 10',/,f15.5,/,' 20',/,f15.5,/,' 30',/,f15.5,/, &
' 11',/,f15.5,/,' 21',/,f15.5,/,' 31',/,f15.5)
! Do any daylighting reference points on layer for zone
do zones=1,numofzones
curcolorno=colorno_DaylSensor1
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 refpt=1,zonedaylight(zones)%TotalDaylRefPoints
write(unit,710) trim(zone(zones)%Name)//':DayRefPt:'//TRIM(TrimSigDigits(refpt))
write(unit,709) trim(TempZoneName),DXFcolorno(curcolorno),zonedaylight(zones)%DaylRefPtAbsCoord(refpt,1), &
zonedaylight(zones)%DaylRefPtAbsCoord(refpt,2), &
zonedaylight(zones)%DaylRefPtAbsCoord(refpt,3),.2
curcolorno=colorno_DaylSensor2 ! ref pts 2 and later are this color
enddo
enddo
! now do DElight reference points
do zones=1,numofzones
curcolorno=colorno_DaylSensor1
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 refpt=1,zonedaylight(zones)%TotalDElightRefPts
write(unit,710) trim(zone(zones)%Name)//':DEDayRefPt:'//TRIM(TrimSigDigits(refpt))
write(unit,709) Trim(TempZoneName),DXFcolorno(curcolorno),zonedaylight(zones)%DaylRefPtAbsCoord(refpt,1), &
zonedaylight(zones)%DaylRefPtAbsCoord(refpt,2), &
zonedaylight(zones)%DaylRefPtAbsCoord(refpt,3),.2
curcolorno=colorno_DaylSensor2 ! ref pts 2 and later are this color
enddo
enddo
write(unit,706)
706 format(' 0',/,'ENDSEC',/,' 0',/,'EOF')
709 format(' 0',/,'CIRCLE',/,' 8',/,A,/,' 62',/,I3,/, &
' 10',/,f15.5,/,' 20',/,f15.5,/,' 30',/,f15.5,/, &
' 40',/,f15.5)
710 format('999',/,A)
close(unit)
return
END SUBROUTINE DXFOutLines