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 DXFOut(PolygonAction,ColorScheme)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN March 1999
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine produces a file of DXF objects 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 DataSurfaceColors
USE DataDaylighting, ONLY: ZoneDaylight,TotIllumMaps,IllumMapCalc
USE DataGlobals, ONLY: DegToRadians,NumOfZones
USE DataInterfaces, ONLY: ShowWarningError, ShowContinueError, ShowFatalError
USE DataStringGlobals, ONLY: VerString
USE DXFEarClipping
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*) :: PolygonAction
CHARACTER(len=*) :: ColorScheme ! Name from user for color scheme or blank
! 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
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
integer :: refpt ! for daylighting ref points
integer :: curcolorno ! again for daylighting ref pts
integer :: write_stat
integer :: mapnum
IF (PolygonAction == 'TRIANGULATE3DFACE' .or. PolygonAction == 'TRIANGULATE' .or. PolygonAction == ' ') THEN
TriangulateFace=.true.
RegularPolyline=.false.
ThickPolyline=.false.
ELSEIF (PolygonAction == 'THICKPOLYLINE') THEN
ThickPolyline=.true.
RegularPolyline=.false.
TriangulateFace=.false.
ELSEIF (PolygonAction == 'REGULARPOLYLINE') THEN
RegularPolyline=.true.
TriangulateFace=.false.
ThickPolyline=.false.
PolylineWidth=' 0'
ELSE
CALL ShowWarningError('DXFOut: Illegal key specified for Surfaces with > 4 sides='//TRIM(PolygonAction))
CALL ShowContinueError('...Valid keys are: "ThickPolyline", "RegularPolyline", "Triangulate3DFace".')
CALL ShowContinueError('"Triangulate3DFace" will be used for any surfaces with > 4 sides.')
TriangulateFace=.true.
RegularPolyline=.false.
ThickPolyline=.false.
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.dxf', Action='write', iostat=write_stat)
if (write_stat /= 0) then
CALL ShowFatalError('DXFOut: 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)
IF (PolygonAction == ' ') THEN
write(unit,708) 'Polygon Action',',','ThickPolyline'
ELSE
write(unit,708) 'Polygon Action',',',TRIM(PolygonAction)
ENDIF
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
colorindex=colorno_ShdDetFix
! 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=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
if (surface(surf)%sides <= 4) then
write(unit,704) TRIM(ShadeType),DXFcolorno(colorindex),(surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y, &
surface(surf)%vertex(vert)%z,vert=1,3)
if (surface(surf)%sides == 3) then
write(unit,705) surface(surf)%vertex(3)%x,surface(surf)%vertex(3)%y,surface(surf)%vertex(3)%z
else
write(unit,705) surface(surf)%vertex(4)%x,surface(surf)%vertex(4)%y,surface(surf)%vertex(4)%z
endif
else ! polygon
if (.not. TriangulateFace) then
minz=99999.d0
do vert=1,surface(surf)%sides
minz=MIN(minz,surface(surf)%vertex(vert)%z)
enddo
write(unit,715) TRIM(ShadeType),DXFcolorno(colorindex),minz,TRIM(PolylineWidth),TRIM(PolylineWidth)
do vert=1,surface(surf)%sides
write(unit,716) TRIM(ShadeType), &
surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z
enddo
write(unit,717) TRIM(ShadeType)
else
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
vv1=mytriangles(svert)%vv1
vv2=mytriangles(svert)%vv2
write(unit,704) TRIM(ShadeType),DXFcolorno(colorindex), &
surface(surf)%vertex(vv0)%x,surface(surf)%vertex(vv0)%y,surface(surf)%vertex(vv0)%z, &
surface(surf)%vertex(vv1)%x,surface(surf)%vertex(vv1)%y,surface(surf)%vertex(vv1)%z, &
surface(surf)%vertex(vv2)%x,surface(surf)%vertex(vv2)%y,surface(surf)%vertex(vv2)%z
write(unit,705) surface(surf)%vertex(vv2)%x,surface(surf)%vertex(vv2)%y,surface(surf)%vertex(vv2)%z
enddo
deallocate(mytriangles)
endif
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=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
write(unit,710) trim(surface(surf)%ZoneName)//':'//trim(surface(surf)%Name)
if (surface(surf)%sides <= 4) then
write(unit,704) TRIM(TempZoneName),DXFcolorno(colorindex),(surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y, &
surface(surf)%vertex(vert)%z,vert=1,3)
if (surface(surf)%sides == 3) then
write(unit,705) surface(surf)%vertex(3)%x,surface(surf)%vertex(3)%y,surface(surf)%vertex(3)%z
else
write(unit,705) surface(surf)%vertex(4)%x,surface(surf)%vertex(4)%y,surface(surf)%vertex(4)%z
endif
else ! polygon surface
if (.not. TriangulateFace) then
minz=99999.d0
do vert=1,surface(surf)%sides
minz=MIN(minz,surface(surf)%vertex(vert)%z)
enddo
write(unit,715) TRIM(TempZoneName),DXFcolorno(colorindex),minz,TRIM(PolylineWidth),TRIM(PolylineWidth)
do vert=1,surface(surf)%sides
write(unit,716) TRIM(TempZoneName), &
surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z
enddo
write(unit,717) TRIM(TempZoneName)
else
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
vv1=mytriangles(svert)%vv1
vv2=mytriangles(svert)%vv2
write(unit,704) TRIM(TempZoneName),DXFcolorno(colorindex), &
surface(surf)%vertex(vv0)%x,surface(surf)%vertex(vv0)%y,surface(surf)%vertex(vv0)%z, &
surface(surf)%vertex(vv1)%x,surface(surf)%vertex(vv1)%y,surface(surf)%vertex(vv1)%z, &
surface(surf)%vertex(vv2)%x,surface(surf)%vertex(vv2)%y,surface(surf)%vertex(vv2)%z
write(unit,705) surface(surf)%vertex(vv2)%x,surface(surf)%vertex(vv2)%y,surface(surf)%vertex(vv2)%z
enddo
deallocate(mytriangles)
endif
endif
715 format(' 0',/,'POLYLINE',/,' 8',/,A,/,' 62',/,I3,/,' 66',/,' 1',/, &
' 10',/,' 0.0',/,' 20',/,' 0.0',/,' 30',/,f15.5,/, &
' 70',/,' 9',/,' 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
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
colorindex=colorno_ShdAtt
if (surface(surf)%isPV) colorindex=colorno_PV
write(unit,710) trim(surface(surf)%ZoneName)//':'//trim(surface(surf)%Name)
if (surface(surf)%sides <= 4) then
write(unit,704) TRIM(TempZoneName),DXFcolorno(colorindex),(surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y, &
surface(surf)%vertex(vert)%z,vert=1,3)
if (surface(surf)%sides == 3) then
write(unit,705) surface(surf)%vertex(3)%x,surface(surf)%vertex(3)%y,surface(surf)%vertex(3)%z
else
write(unit,705) surface(surf)%vertex(4)%x,surface(surf)%vertex(4)%y,surface(surf)%vertex(4)%z
endif
else ! polygon attached shading
if (.not. TriangulateFace) then
minz=99999.d0
do vert=1,surface(surf)%sides
minz=MIN(minz,surface(surf)%vertex(vert)%z)
enddo
write(unit,715) TRIM(TempZoneName),DXFcolorno(colorindex),minz,TRIM(PolylineWidth),TRIM(PolylineWidth)
do vert=1,surface(surf)%sides
write(unit,716) TRIM(TempZoneName), &
surface(surf)%vertex(vert)%x,surface(surf)%vertex(vert)%y,surface(surf)%vertex(vert)%z
enddo
write(unit,717) TRIM(TempZoneName)
else
if (surface(surf)%shape == RectangularOverhang) then
ntri=triangulate(surface(surf)%sides,surface(surf)%vertex,mytriangles,surface(surf)%azimuth, &
surface(surf)%tilt,surface(surf)%name,SurfaceClass_Overhang)
else
ntri=triangulate(surface(surf)%sides,surface(surf)%vertex,mytriangles,surface(surf)%azimuth, &
surface(surf)%tilt,surface(surf)%name,SurfaceClass_Fin)
endif
do svert=1,ntri
vv0=mytriangles(svert)%vv0
vv1=mytriangles(svert)%vv1
vv2=mytriangles(svert)%vv2
write(unit,704) TRIM(TempZoneName),DXFcolorno(colorindex), &
surface(surf)%vertex(vv0)%x,surface(surf)%vertex(vv0)%y,surface(surf)%vertex(vv0)%z, &
surface(surf)%vertex(vv1)%x,surface(surf)%vertex(vv1)%y,surface(surf)%vertex(vv1)%z, &
surface(surf)%vertex(vv2)%x,surface(surf)%vertex(vv2)%y,surface(surf)%vertex(vv2)%z
write(unit,705) surface(surf)%vertex(vv2)%x,surface(surf)%vertex(vv2)%y,surface(surf)%vertex(vv2)%z
enddo
deallocate(mytriangles)
endif
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
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 mapnum=1,totillummaps
if (IllumMapCalc(mapnum)%Zone /= zones) cycle
do refpt=1,IllumMapCalc(mapnum)%TotalMapRefPoints
write(unit,710) trim(zone(zones)%Name)//':MapRefPt:'//TRIM(TrimSigDigits(refpt))
write(unit,709) trim(TempZoneName),DXFcolorno(curcolorno),IllumMapCalc(mapnum)%MapRefPtAbsCoord(refpt,1), &
IllumMapCalc(mapnum)%MapRefPtAbsCoord(refpt,2), &
IllumMapCalc(mapnum)%MapRefPtAbsCoord(refpt,3),.05
enddo
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 DXFOut