SUBROUTINE GetDaylightingParametersDetaild(TotDaylightingDetailed,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN March 2002
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtain the user input data for Daylighting:Detailed objects in the input file.
! For detailed daylighting, a calculation of interior daylight illuminance is done at one
! or two reference points; the illuminance level, setpoint and type of control
! system determines lighting power reduction.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! none
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, FindIteminList
USE DataStringGlobals, ONLY: CharSpace, CharComma, CharTab
USE InternalHeatGains, ONLY: CheckLightsReplaceableMinMaxForZone, GetDesignLightingLevelForZone
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE OutputReportPredefined
USE ScheduleManager, ONLY: GetScheduleIndex
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: TotDaylightingDetailed ! Total "simple" daylighting inputs
LOGICAL, INTENT(INOUT) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank=' '
! INTERFACE BLOCK SPECIFICATIONS: na
! DERIVED TYPE DEFINITIONS: na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat
INTEGER :: Loop1
INTEGER :: MapStyleIn
INTEGER :: NumAlpha
INTEGER :: NumNumber
INTEGER :: ZoneNum
INTEGER :: MapNum
INTEGER :: RefPt
INTEGER :: X, Y
INTEGER :: SurfLoop
INTEGER :: AddMapPoints
INTEGER :: ZoneFound
CHARACTER(len=MaxNameLength) :: refName
REAL(r64) :: CosBldgRelNorth ! Cosine of Building rotation
REAL(r64) :: SinBldgRelNorth ! Sine of Building rotation
REAL(r64) :: CosZoneRelNorth ! Cosine of Zone rotation
REAL(r64) :: SinZoneRelNorth ! Sine of Zone rotation
REAL(r64) :: CosBldgRotAppGonly =0.0D0 ! Cosine of the building rotation for appendix G only (relative north)
REAL(r64) :: SinBldgRotAppGonly =0.0D0 ! Sine of the building rotation for appendix G only (relative north)
REAL(r64) :: Xb ! temp var for transformation calc
REAL(r64) :: Yb ! temp var for transformation calc
REAL(r64) :: Xo, XnoRot, Xtrans
REAL(r64) :: Yo, YnoRot, Ytrans
Logical :: doTransform
REAL(r64) :: OldAspectRatio
REAL(r64) :: NewAspectRatio
REAL(r64) :: rLightLevel
LOGICAL,ALLOCATABLE,DIMENSION(:) :: ZoneMsgDone
INTEGER,ALLOCATABLE,DIMENSION(:) :: ZoneMapCount
! FLOW:
! Calc cos and sin of Building Relative North values for later use in transforming Reference Point coordinates
CosBldgRelNorth = COS(-(BuildingAzimuth + BuildingRotationAppendixG)*DegToRadians)
SinBldgRelNorth = SIN(-(BuildingAzimuth + BuildingRotationAppendixG)*DegToRadians)
! these are only for Building Rotation for Appendix G when using world coordinate system
CosBldgRotAppGonly = COS(-BuildingRotationAppendixG*DegToRadians)
SinBldgRotAppGonly = SIN(-BuildingRotationAppendixG*DegToRadians)
doTransform=.false.
OldAspectRatio=1.0d0
NewAspectRatio=1.0d0
CALL CheckForGeometricTransform(DoTransform,OldAspectRatio,NewAspectRatio)
! Get and initialize illuminance map objects
cCurrentModuleObject='Output:IlluminanceMap'
TotIllumMaps = GetNumObjectsFound(cCurrentModuleObject)
ALLOCATE(IllumMap(TotIllumMaps))
ALLOCATE(IllumMapCalc(TotIllumMaps))
ALLOCATE(ZoneMapCount(NumOfZones))
ZoneMapCount=0
IF (TotIllumMaps > 0) THEN
DO MapNum = 1, TotIllumMaps
CALL GetObjectItem(cCurrentModuleObject,MapNum,cAlphaArgs,NumAlpha,rNumericArgs,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IllumMap(MapNum)%Name = cAlphaArgs(1)
IllumMap(MapNum)%Zone = FindIteminList(cAlphaArgs(2),Zone%Name,NumOfZones)
IF (IllumMap(MapNum)%Zone == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", invalid '//TRIM(cAlphaFieldNames(2))//'="'// &
TRIM(cAlphaArgs(2))//'".')
ErrorsFound = .TRUE.
ENDIF
IllumMapCalc(MapNum)%Zone=IllumMap(MapNum)%Zone
IF (IllumMap(MapNum)%Zone /= 0) THEN
ZoneMapCount(IllumMap(MapNum)%Zone)=ZoneMapCount(IllumMap(MapNum)%Zone)+1
ENDIF
IllumMap(MapNum)%Z = rNumericArgs(1)
IllumMap(MapNum)%Xmin = rNumericArgs(2)
IllumMap(MapNum)%Xmax = rNumericArgs(3)
IF (rNumericArgs(2) > rNumericArgs(3)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", invalid entry.')
CALL ShowContinueError('...'//trim(cNumericFieldNames(2))//'['//trim(RoundSigDigits(rNumericArgs(2),2))// &
'] must be <= '//trim(cNumericFieldNames(3))//'['//trim(RoundSigDigits(rNumericArgs(3),2))//'].')
ErrorsFound = .TRUE.
ENDIF
IllumMap(MapNum)%Xnum = rNumericArgs(4)
IF (IllumMap(MapNum)%Xnum /= 1) THEN
IllumMap(MapNum)%Xinc = (IllumMap(MapNum)%Xmax - IllumMap(MapNum)%Xmin) / (IllumMap(MapNum)%Xnum - 1)
ELSE
IllumMap(MapNum)%Xinc = 0.0d0
ENDIF
IllumMap(MapNum)%Ymin = rNumericArgs(5)
IllumMap(MapNum)%Ymax = rNumericArgs(6)
IF (rNumericArgs(5) > rNumericArgs(6)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", invalid entry.')
CALL ShowContinueError('...'//trim(cNumericFieldNames(5))//'['//trim(RoundSigDigits(rNumericArgs(5),2))// &
'] must be <= '//trim(cNumericFieldNames(6))//'['//trim(RoundSigDigits(rNumericArgs(6),2))//'].')
ErrorsFound = .TRUE.
ENDIF
IllumMap(MapNum)%Ynum = rNumericArgs(7)
IF (IllumMap(MapNum)%Ynum /= 1) THEN
IllumMap(MapNum)%Yinc = (IllumMap(MapNum)%Ymax - IllumMap(MapNum)%Ymin) / (IllumMap(MapNum)%Ynum - 1)
ELSE
IllumMap(MapNum)%Yinc = 0.0d0
ENDIF
IF (IllumMap(MapNum)%Xnum*IllumMap(MapNum)%Ynum > MaxMapRefPoints) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", too many map points specified.')
CALL ShowContinueError('...'//trim(cNumericFieldNames(4))//'['//trim(RoundSigDigits(IllumMap(MapNum)%Xnum))// &
'] * '//trim(cNumericFieldNames(7))//'['//trim(RoundSigDigits(IllumMap(MapNum)%Ynum))//'].'// &
'= ['//TRIM(RoundSigDigits(IllumMap(MapNum)%Xnum*IllumMap(MapNum)%Ynum))//'] must be <= ['// &
TRIM(RoundSigDigits(MaxMapRefPoints))//'].')
ErrorsFound=.true.
ENDIF
END DO ! MapNum
cCurrentModuleObject='OutputControl:IlluminanceMap:Style'
MapStyleIn = GetNumObjectsFound(cCurrentModuleObject)
IF (MapStyleIn == 0) THEN
cAlphaArgs(1)='COMMA'
MapColSep = CharComma !comma
ELSEIF (MapStyleIn == 1) THEN
CALL GetObjectItem(cCurrentModuleObject,1,cAlphaArgs,NumAlpha,rNumericArgs,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (cAlphaArgs(1) == 'COMMA') THEN
MapColSep = CharComma !comma
ELSEIF (cAlphaArgs(1) == 'TAB') THEN
MapColSep = CharTab !tab
ELSEIF (cAlphaArgs(1) == 'FIXED' .or. cAlphaArgs(1) == 'SPACE') THEN
MapColSep = CharSpace ! space
ELSE
MapColSep = CharComma !comma
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(cAlphaArgs(1))//'", Commas will be used to separate fields.')
cAlphaArgs(1)='COMMA'
ENDIF
ENDIF
Write(OutputFileInits,'(A)') '! <Daylighting:Illuminance Maps>,#Maps,Style'
CALL ConvertCaseToLower(cAlphaArgs(1),cAlphaArgs(2))
cAlphaArgs(1)(2:)=cAlphaArgs(2)(2:)
WRITE(OutputFileInits,"('Daylighting:Illuminance Maps,',A,',',A)") TRIM(TrimSigDigits(TotIllumMaps)),TRIM(cAlphaArgs(1))
END IF
DO Loop1=1,NumOfZones
ALLOCATE(ZoneDaylight(Loop1)%ZoneToMap(ZoneMapCount(Loop1)))
ZoneDayLight(Loop1)%ZoneToMap=0
ZoneDayLight(Loop1)%MapCount=0
ENDDO
DO MapNum=1,TotIllumMaps
IF (IllumMap(MapNum)%Zone == 0) CYCLE
ZoneDayLight(IllumMap(MapNum)%Zone)%MapCount=ZoneDayLight(IllumMap(MapNum)%Zone)%MapCount+1
ZoneDayLight(IllumMap(MapNum)%Zone)%ZoneToMap(ZoneDayLight(IllumMap(MapNum)%Zone)%MapCount)=MapNum
ENDDO
DEALLOCATE(ZoneMapCount)
cCurrentModuleObject='Daylighting:Controls'
DO Loop1 = 1, TotDaylightingDetailed
cAlphaArgs=' '
rNumericArgs=0.0d0
CALL GetObjectItem(cCurrentModuleObject,Loop1,cAlphaArgs,NumAlpha,rNumericArgs,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! First is Zone Name
ZoneFound=FindIteminList(cAlphaArgs(1),Zone%Name,NumOfZones)
IF (ZoneFound == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(cAlphaArgs(1))//'".')
ErrorsFound=.true.
CYCLE
END IF
! Calc cos and sin of Zone Relative North values for later use in transforming Reference Point coordinates
CosZoneRelNorth = COS(-Zone(ZoneFound)%RelNorth*DegToRadians)
SinZoneRelNorth = SIN(-Zone(ZoneFound)%RelNorth*DegToRadians)
IF (ZoneDaylight(ZoneFound)%DaylightType /= NoDaylighting) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
': Attempted to apply Detailed Daylighting to a Zone with Previous Daylighting')
CALL ShowContinueError('Error discovered for Zone='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Previously applied Daylighting Type='//TRIM(DaylightTypes(ZoneDaylight(ZoneFound)%DaylightType)))
ErrorsFound=.true.
CYCLE
ENDIF
ZoneDaylight(ZoneFound)%DaylightType=DetailedDaylighting
ZoneDaylight(ZoneFound)%TotalDaylRefPoints=rNumericArgs(1)
rLightLevel=GetDesignLightingLevelForZone(ZoneFound)
CALL CheckLightsReplaceableMinMaxForZone(ZoneFound)
ALLOCATE(ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(MaxRefPoints,3))
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord =0.0d0
ALLOCATE(ZoneDaylight(ZoneFound)%DaylRefPtInBounds(MaxRefPoints))
ZoneDaylight(ZoneFound)%DaylRefPtInBounds =.true.
ALLOCATE(ZoneDaylight(ZoneFound)%FracZoneDaylit(MaxRefPoints))
ZoneDaylight(ZoneFound)%FracZoneDaylit =0.0d0
ALLOCATE(ZoneDaylight(ZoneFound)%IllumSetPoint(MaxRefPoints))
ZoneDaylight(ZoneFound)%IllumSetPoint =0.0d0
ALLOCATE(ZoneDaylight(ZoneFound)%RefPtPowerReductionFactor(MaxRefPoints))
ZoneDaylight(ZoneFound)%RefPtPowerReductionFactor =1.0d0
ALLOCATE(ZoneDaylight(ZoneFound)%DaylIllumAtRefPt(MaxRefPoints))
ZoneDaylight(ZoneFound)%DaylIllumAtRefPt =0.0d0
ALLOCATE(ZoneDaylight(ZoneFound)%GlareIndexAtRefPt(MaxRefPoints))
ZoneDaylight(ZoneFound)%GlareIndexAtRefPt =0.0d0
ALLOCATE(ZoneDaylight(ZoneFound)%BacLum(MaxRefPoints))
ZoneDaylight(ZoneFound)%BacLum =0.0d0
!added TH 12/2/2008
ALLOCATE(ZoneDaylight(ZoneFound)%TimeExceedingGlareIndexSPAtRefPt(MaxRefPoints))
ZoneDaylight(ZoneFound)%TimeExceedingGlareIndexSPAtRefPt = 0.0d0
!added TH 7/6/2009
ALLOCATE(ZoneDaylight(ZoneFound)%TimeExceedingDaylightIlluminanceSPAtRefPt(MaxRefPoints))
ZoneDaylight(ZoneFound)%TimeExceedingDaylightIlluminanceSPAtRefPt = 0.0d0
IF (ZoneDaylight(ZoneFound)%TotalDaylRefPoints >= 1) THEN
IF (DaylRefWorldCoordSystem) THEN
!transform only by appendix G rotation
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,1) = rNumericArgs(2)*CosBldgRotAppGonly - rNumericArgs(3)*SinBldgRotAppGonly
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,2) = rNumericArgs(2)*SinBldgRotAppGonly + rNumericArgs(3)*CosBldgRotAppGonly
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,3) = rNumericArgs(4)
ELSE
!Transform reference point coordinates into building coordinate system
Xb = rNumericArgs(2)*CosZoneRelNorth &
- rNumericArgs(3)*SinZoneRelNorth &
+ Zone(ZoneFound)%OriginX
Yb = rNumericArgs(2)*SinZoneRelNorth &
+ rNumericArgs(3)*CosZoneRelNorth &
+ Zone(ZoneFound)%OriginY
!Transform into World Coordinate System
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,1) = Xb*CosBldgRelNorth - Yb*SinBldgRelNorth
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,2) = Xb*SinBldgRelNorth + Yb*CosBldgRelNorth
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,3) = rNumericArgs(4) + &
Zone(ZoneFound)%OriginZ
IF (doTransform) THEN
Xo = ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,1) ! world coordinates.... shifted by relative north angle...
Yo = ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,2)
! 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
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,1) = Xtrans * CosBldgRelNorth - Ytrans * SinBldgRelNorth
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(1,2) = Xtrans * SinBldgRelNorth + Ytrans * CosBldgRelNorth
ENDIF
ENDIF
ZoneDaylight(ZoneFound)%FracZoneDaylit(1) = rNumericArgs(8)
ZoneDaylight(ZoneFound)%IllumSetPoint(1) = rNumericArgs(10)
ENDIF
IF (ZoneDaylight(ZoneFound)%TotalDaylRefPoints >= 2) THEN
IF (DaylRefWorldCoordSystem) THEN
!transform only by appendix G rotation
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,1) = rNumericArgs(5)*CosBldgRotAppGonly - rNumericArgs(6)*SinBldgRotAppGonly
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,2) = rNumericArgs(5)*SinBldgRotAppGonly + rNumericArgs(6)*CosBldgRotAppGonly
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,3) = rNumericArgs(7)
ELSE
!Transform reference point coordinates into building coordinate system
Xb = rNumericArgs(5)*CosZoneRelNorth &
- rNumericArgs(6)*SinZoneRelNorth &
+ Zone(ZoneFound)%OriginX
Yb = rNumericArgs(5)*SinZoneRelNorth &
+ rNumericArgs(6)*CosZoneRelNorth &
+ Zone(ZoneFound)%OriginY
!Transform into World Coordinate System
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,1) = Xb*CosBldgRelNorth - Yb*SinBldgRelNorth
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,2) = Xb*SinBldgRelNorth + Yb*CosBldgRelNorth
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,3) = rNumericArgs(7) + &
Zone(ZoneFound)%OriginZ
IF (doTransform) THEN
Xo = ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,1) ! world coordinates.... shifted by relative north angle...
Yo = ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,2)
! 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
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,1) = Xtrans * CosBldgRelNorth - Ytrans * SinBldgRelNorth
ZoneDaylight(ZoneFound)%DaylRefPtAbsCoord(2,2) = Xtrans * SinBldgRelNorth + Ytrans * CosBldgRelNorth
ENDIF
ENDIF
ZoneDaylight(ZoneFound)%FracZoneDaylit(2) = rNumericArgs(9)
ZoneDaylight(ZoneFound)%IllumSetPoint(2) = rNumericArgs(11)
ENDIF
do refpt=1,ZoneDaylight(ZoneFound)%TotalDaylRefPoints
IF (ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,1) < Zone(ZoneFound)%MinimumX .or. &
ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,1) > Zone(ZoneFound)%MaximumX) THEN
ZoneDaylight(ZoneFound)%DaylrefptInBounds(refpt)=.false.
CALL ShowWarningError('GetDetailedDaylighting: Reference point X Value outside Zone Min/Max X, Zone='// &
TRIM(Zone(ZoneFound)%Name))
CALL ShowContinueError('...X Reference Point= '// &
TRIM(RoundSigDigits(ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,1),2))//', Zone Minimum X= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumX,2))//', Zone Maximum X= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MaximumX,2)))
IF (ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,1) < Zone(ZoneFound)%MinimumX) THEN
CALL ShowContinueError('...X Reference Distance Outside MinimumX= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumX-ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,1),4))//' m.')
ELSE
CALL ShowContinueError('...X Reference Distance Outside MaximumX= '// &
TRIM(RoundSigDigits(ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,1)-Zone(ZoneFound)%MaximumX,4))//' m.')
ENDIF
ENDIF
IF (ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,2) < Zone(ZoneFound)%MinimumY .or. &
ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,2) > Zone(ZoneFound)%MaximumY) THEN
ZoneDaylight(ZoneFound)%DaylrefptInBounds(refpt)=.false.
CALL ShowWarningError('GetDetailedDaylighting: Reference point Y Value outside Zone Min/Max Y, Zone='// &
TRIM(Zone(ZoneFound)%Name))
CALL ShowContinueError('...Y Reference Point= '// &
TRIM(RoundSigDigits(ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,2),2))//', Zone Minimum Y= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumY,2))//', Zone Maximum Y= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MaximumY,2)))
IF (ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,2) < Zone(ZoneFound)%MinimumY) THEN
CALL ShowContinueError('...Y Reference Distance Outside MinimumY= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumY-ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,2),4))//' m.')
ELSE
CALL ShowContinueError('...Y Reference Distance Outside MaximumY= '// &
TRIM(RoundSigDigits(ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,2)-Zone(ZoneFound)%MaximumY,4))//' m.')
ENDIF
ENDIF
IF (ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,3) < Zone(ZoneFound)%MinimumZ .or. &
ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,3) > Zone(ZoneFound)%MaximumZ) THEN
ZoneDaylight(ZoneFound)%DaylrefptInBounds(refpt)=.false.
CALL ShowWarningError('GetDetailedDaylighting: Reference point Z Value outside Zone Min/Max Z, Zone='// &
TRIM(Zone(ZoneFound)%Name))
CALL ShowContinueError('...Z Reference Point= '// &
TRIM(RoundSigDigits(ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(refpt,3),2))//', Zone Minimum Z= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumZ,2))//', Zone Maximum Z= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MaximumZ,2)))
IF (ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,3) < Zone(ZoneFound)%MinimumZ) THEN
CALL ShowContinueError('...Z Reference Distance Outside MinimumZ= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumZ-ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,3),4))//' m.')
ELSE
CALL ShowContinueError('...Z Reference Distance Outside MaximumZ= '// &
TRIM(RoundSigDigits(ZoneDaylight(ZoneFound)%DaylrefptAbsCoord(RefPt,3)-Zone(ZoneFound)%MaximumZ,4))//' m.')
ENDIF
ENDIF
END DO ! RefPt
IF (SUM(ZoneDaylight(ZoneFound)%FracZoneDaylit) < 1.0d0) THEN
CALL ShowWarningError('GetDetailedDaylighting: Fraction of Zone controlled by the Daylighting reference points is < 1.0.')
CALL ShowContinueError('..discovered in "'//TRIM(cCurrentModuleObject)//'" for Zone="'//TRIM(cAlphaArgs(1))//'", only '// &
TRIM(RoundSigDigits(SUM(ZoneDaylight(ZoneFound)%FracZoneDaylit),2))//' of the zone is controlled.')
ENDIF
IF (SUM(ZoneDaylight(ZoneFound)%FracZoneDaylit) > 1.0d0) THEN
CALL ShowSevereError('GetDetailedDaylighting: Fraction of Zone controlled by the Daylighting reference points is > 1.0.')
CALL ShowContinueError('..discovered in "'//TRIM(cCurrentModuleObject)//'" for Zone="'//TRIM(cAlphaArgs(1))// &
'", trying to control '//TRIM(RoundSigDigits(SUM(ZoneDaylight(ZoneFound)%FracZoneDaylit),2))//' of the zone.')
ErrorsFound=.true.
ENDIF
ZoneDaylight(ZoneFound)%LightControlType=rNumericArgs(12) ! Relies on IDD limits for verification
ZoneDaylight(ZoneFound)%ViewAzimuthForGlare=rNumericArgs(13)
ZoneDaylight(ZoneFound)%MaxGlareallowed=rNumericArgs(14)
ZoneDaylight(ZoneFound)%MinPowerFraction=rNumericArgs(15)
ZoneDaylight(ZoneFound)%MinLightFraction=rNumericArgs(16)
ZoneDaylight(ZoneFound)%LightControlSteps=rNumericArgs(17)
IF (ZoneDaylight(ZoneFound)%LightControlType == 2 .and. ZoneDaylight(ZoneFound)%LightControlSteps <= 0) THEN
CALL ShowWarningError('GetDetailedDaylighting: For Stepped Control, the number of steps must be > 0')
CALL ShowContinueError('..discovered in "'//TRIM(cCurrentModuleObject)//'" for Zone="'//TRIM(cAlphaArgs(1))// &
'", will use 1')
ZoneDaylight(ZoneFound)%LightControlSteps=1
ENDIF
ZoneDaylight(ZoneFound)%LightControlProbability=rNumericArgs(18)
IF (.NOT. lAlphaFieldBlanks(2)) THEN
ZoneDaylight(ZoneFound)%AvailSchedNum = GetScheduleIndex(cAlphaArgs(2))
IF (ZoneDaylight(ZoneFound)%AvailSchedNum == 0) THEN
CALL ShowWarningError('Invalid '//TRIM(cAlphaFieldNames(2))//' = '//TRIM(cAlphaArgs(2)) &
//', occurs in '//TRIM(cCurrentModuleObject)//'object for '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('Schedule was not found so controls will always be available, and the simulation continues.')
ZoneDaylight(ZoneFound)%AvailSchedNum = ScheduleAlwaysOn
ENDIF
ELSE
ZoneDaylight(ZoneFound)%AvailSchedNum = ScheduleAlwaysOn
ENDIF
IF (ZoneDaylight(ZoneFound)%TotalDaylRefPoints >= 1) THEN
refName = TRIM(cAlphaArgs(1)) // ' - REF 1'
CALL PreDefTableEntry(pdchDyLtZone,refName,cAlphaArgs(1))
CALL PreDefTableEntry(pdchDyLtKind,refName,'Detailed')
! (1=continuous, 2=stepped, 3=continuous/off)
SELECT CASE (ZoneDaylight(ZoneFound)%LightControlType)
CASE (1)
CALL PreDefTableEntry(pdchDyLtCtrl,refName,'Continuous')
CASE (2)
CALL PreDefTableEntry(pdchDyLtCtrl,refName,'Stepped')
CASE (3)
CALL PreDefTableEntry(pdchDyLtCtrl,refName,'Continuous/Off')
END SELECT
CALL PreDefTableEntry(pdchDyLtFrac,refName,ZoneDaylight(ZoneFound)%FracZoneDaylit(1))
CALL PreDefTableEntry(pdchDyLtWInst, refName, rLightLevel)
CALL PreDefTableEntry(pdchDyLtWCtrl, refName, rLightLevel * ZoneDaylight(ZoneFound)%FracZoneDaylit(1))
END IF
IF (ZoneDaylight(ZoneFound)%TotalDaylRefPoints >= 2) THEN
refName = TRIM(cAlphaArgs(1)) // ' - REF 2'
CALL PreDefTableEntry(pdchDyLtZone,refName,cAlphaArgs(1))
CALL PreDefTableEntry(pdchDyLtKind,refName,'Detailed')
! (1=continuous, 2=stepped, 3=continuous/off)
SELECT CASE (ZoneDaylight(ZoneFound)%LightControlType)
CASE (1)
CALL PreDefTableEntry(pdchDyLtCtrl,refName,'Continuous')
CASE (2)
CALL PreDefTableEntry(pdchDyLtCtrl,refName,'Stepped')
CASE (3)
CALL PreDefTableEntry(pdchDyLtCtrl,refName,'Continuous/Off')
END SELECT
CALL PreDefTableEntry(pdchDyLtFrac,refName,ZoneDaylight(ZoneFound)%FracZoneDaylit(2))
CALL PreDefTableEntry(pdchDyLtWInst, refName, rLightLevel)
CALL PreDefTableEntry(pdchDyLtWCtrl, refName, rLightLevel * ZoneDaylight(ZoneFound)%FracZoneDaylit(2))
END IF
! Check for illuminance maps associated with this zone
DO MapNum = 1, TotIllumMaps
IF (IllumMap(MapNum)%Zone == ZoneFound) THEN
IF (IllumMap(MapNum)%Xnum*IllumMap(MapNum)%Ynum > 0) THEN
! Add additional daylighting reference points for map
AddMapPoints = IllumMap(MapNum)%Xnum*IllumMap(MapNum)%Ynum
IllumMapCalc(MapNum)%TotalMapRefPoints=AddMapPoints
ALLOCATE(IllumMapCalc(MapNum)%MapRefPtAbsCoord(AddMapPoints,3))
IllumMapCalc(MapNum)%MapRefPtAbsCoord=0.0d0
ALLOCATE(IllumMapCalc(MapNum)%MapRefPtInBounds(AddMapPoints))
IllumMapCalc(MapNum)%MapRefPtInBounds =.true.
ALLOCATE(IllumMapCalc(MapNum)%DaylIllumAtMapPt(AddMapPoints))
IllumMapCalc(MapNum)%DaylIllumAtMapPt=0.0d0
ALLOCATE(IllumMapCalc(MapNum)%GlareIndexAtMapPt(AddMapPoints))
IllumMapCalc(MapNum)%GlareIndexAtMapPt=0.0d0
ALLOCATE(IllumMapCalc(MapNum)%DaylIllumAtMapPtHr(AddMapPoints))
IllumMapCalc(MapNum)%DaylIllumAtMapPtHr=0.0d0
ALLOCATE(IllumMapCalc(MapNum)%GlareIndexAtMapPtHr(AddMapPoints))
IllumMapCalc(MapNum)%GlareIndexAtMapPtHr=0.0d0
IF (AddMapPoints > MaxMapRefPoints) THEN
CALL ShowSevereError('GetDaylighting Parameters: Total Map Reference points entered is greater than maximum allowed.')
CALL ShowContinueError('Occurs in Zone='//TRIM(Zone(ZoneFound)%Name))
CALL ShowContinueError('Maximum reference points allowed='// &
TRIM(TrimSigDigits(MaxMapRefPoints))// &
', entered amount (when error first occurred)='// &
TRIM(TrimSigDigits(AddMapPoints)))
ErrorsFound=.true.
EXIT
ENDIF
RefPt=1
! Calc cos and sin of Zone Relative North values for later use in transforming Map Point coordinates
CosZoneRelNorth = COS(-Zone(ZoneFound)%RelNorth*DegToRadians)
SinZoneRelNorth = SIN(-Zone(ZoneFound)%RelNorth*DegToRadians)
IF (IllumMap(MapNum)%Xnum /= 1) THEN
IllumMap(MapNum)%Xinc = (IllumMap(MapNum)%Xmax - IllumMap(MapNum)%Xmin) / (IllumMap(MapNum)%Xnum - 1)
ELSE
IllumMap(MapNum)%Xinc = 0.0d0
ENDIF
IF (IllumMap(MapNum)%Ynum /= 1) THEN
IllumMap(MapNum)%Yinc = (IllumMap(MapNum)%Ymax - IllumMap(MapNum)%Ymin) / (IllumMap(MapNum)%Ynum - 1)
ELSE
IllumMap(MapNum)%Yinc = 0.0d0
ENDIF
! Map points and increments are stored in AbsCoord and then that is operated on if relative coords entered.
DO Y = 1, IllumMap(MapNum)%Ynum
DO X = 1, IllumMap(MapNum)%Xnum
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) = IllumMap(MapNum)%Xmin + (X - 1)*IllumMap(MapNum)%Xinc
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) = IllumMap(MapNum)%Ymin + (Y - 1)*IllumMap(MapNum)%Yinc
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) = IllumMap(MapNum)%Z
RefPt = RefPt + 1
ENDDO
ENDDO
RefPt=1
DO Y = 1, IllumMap(MapNum)%Ynum
DO X = 1, IllumMap(MapNum)%Xnum
IF (.not. DaylRefWorldCoordSystem) THEN
Xb = IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) * CosZoneRelNorth &
- IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) * SinZoneRelNorth &
+ Zone(ZoneFound)%OriginX
Yb = IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) * SinZoneRelNorth &
+ IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) * CosZoneRelNorth &
+ Zone(ZoneFound)%OriginY
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) = Xb * CosBldgRelNorth - Yb * SinBldgRelNorth
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) = Xb * SinBldgRelNorth + Yb * CosBldgRelNorth
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) = IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) + &
Zone(ZoneFound)%OriginZ
IF (doTransform) THEN
Xo = IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) ! world coordinates.... shifted by relative north angle...
Yo = IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2)
! 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
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) = Xtrans * CosBldgRelNorth - Ytrans * SinBldgRelNorth
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) = Xtrans * SinBldgRelNorth + Ytrans * CosBldgRelNorth
ENDIF
ELSE
Xb = IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1)
Yb = IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2)
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) = Xb * CosBldgRotAppGonly - Yb * SinBldgRotAppGonly
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) = Xb * SinBldgRotAppGonly + Yb * CosBldgRotAppGonly
ENDIF
IF (RefPt == 1) THEN
IllumMap(MapNum)%Xmin=IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1)
IllumMap(MapNum)%Ymin=IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2)
IllumMap(MapNum)%Xmax=IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1)
IllumMap(MapNum)%Ymax=IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2)
IllumMap(MapNum)%Z =IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3)
ENDIF
IllumMap(MapNum)%Xmin=MIN(IllumMap(MapNum)%Xmin,IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1))
IllumMap(MapNum)%Ymin=MIN(IllumMap(MapNum)%Ymin,IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2))
IllumMap(MapNum)%Xmax=MAX(IllumMap(MapNum)%Xmax,IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1))
IllumMap(MapNum)%Ymax=MAX(IllumMap(MapNum)%Ymax,IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2))
IF ((IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) < Zone(ZoneFound)%MinimumX .and. &
(Zone(ZoneFound)%MinimumX - IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1)) > .001d0) .or. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) > Zone(ZoneFound)%MaximumX .and. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) - Zone(ZoneFound)%MaximumX) > .001d0) .or. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) < Zone(ZoneFound)%MinimumY .and. &
(Zone(ZoneFound)%MinimumY - IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2)) > .001d0) .or. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) > Zone(ZoneFound)%MaximumY .and. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) - Zone(ZoneFound)%MaximumY) > .001d0) .or. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) < Zone(ZoneFound)%MinimumZ .and. &
(Zone(ZoneFound)%MinimumZ - IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3)) > .001d0) .or. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) > Zone(ZoneFound)%MaximumZ .and. &
(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) - Zone(ZoneFound)%MaximumZ) > .001d0)) THEN
IllumMapCalc(MapNum)%MapRefPtInBounds(RefPt)=.false.
ENDIF
! Test extremes of Map Points against Zone Min/Max
IF (RefPt == 1 .or. RefPt == IllumMapCalc(MapNum)%TotalMapRefPoints) THEN
IF ((IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) < Zone(ZoneFound)%MinimumX .or. &
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) > Zone(ZoneFound)%MaximumX) .and. &
.not. IllumMapCalc(MapNum)%MapRefPtInBounds(RefPt)) THEN
CALL ShowWarningError('GetDetailedDaylighting: Reference Map point #['// &
TRIM(RoundSigDigits(RefPt))//'], X Value outside Zone Min/Max X, Zone='// &
TRIM(Zone(ZoneFound)%Name))
CALL ShowContinueError('...X Reference Point= '// &
TRIM(RoundSigDigits(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1),2))//', Zone Minimum X= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumX,2))//', Zone Maximum X= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MaximumX,2)))
IF (IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1) < Zone(ZoneFound)%MinimumX) THEN
CALL ShowContinueError('...X Reference Distance Outside MinimumX= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumX-IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1),4))//' m.')
ELSE
CALL ShowContinueError('...X Reference Distance Outside MaximumX= '// &
TRIM(RoundSigDigits(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,1)-Zone(ZoneFound)%MaximumX,4))//' m.')
ENDIF
ENDIF
IF ((IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) < Zone(ZoneFound)%MinimumY .or. &
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) > Zone(ZoneFound)%MaximumY) .and. &
.not. IllumMapCalc(MapNum)%MapRefPtInBounds(RefPt)) THEN
CALL ShowWarningError('GetDetailedDaylighting: Reference Map point #['// &
TRIM(RoundSigDigits(RefPt))//'], Y Value outside Zone Min/Max Y, Zone='// &
TRIM(Zone(ZoneFound)%Name))
CALL ShowContinueError('...Y Reference Point= '// &
TRIM(RoundSigDigits(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2),2))//', Zone Minimum Y= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumY,2))//', Zone Maximum Y= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MaximumY,2)))
IF (IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2) < Zone(ZoneFound)%MinimumY) THEN
CALL ShowContinueError('...Y Reference Distance Outside MinimumY= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumY-IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2),4))//' m.')
ELSE
CALL ShowContinueError('...Y Reference Distance Outside MaximumY= '// &
TRIM(RoundSigDigits(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,2)-Zone(ZoneFound)%MaximumY,4))//' m.')
ENDIF
ENDIF
IF ((IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) < Zone(ZoneFound)%MinimumZ .or. &
IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) > Zone(ZoneFound)%MaximumZ) .and. &
.not. IllumMapCalc(MapNum)%MapRefPtInBounds(RefPt)) THEN
CALL ShowWarningError('GetDetailedDaylighting: Reference Map point #['// &
TRIM(RoundSigDigits(RefPt))//'], Z Value outside Zone Min/Max Z, Zone='// &
TRIM(Zone(ZoneFound)%Name))
CALL ShowContinueError('...Z Reference Point= '// &
TRIM(RoundSigDigits(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3),2))//', Zone Minimum Z= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumZ,2))//', Zone Maximum Z= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MaximumZ,2)))
IF (IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3) < Zone(ZoneFound)%MinimumZ) THEN
CALL ShowContinueError('...Z Reference Distance Outside MinimumZ= '// &
TRIM(RoundSigDigits(Zone(ZoneFound)%MinimumZ-IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3),4))//' m.')
ELSE
CALL ShowContinueError('...Z Reference Distance Outside MaximumZ= '// &
TRIM(RoundSigDigits(IllumMapCalc(MapNum)%MapRefPtAbsCoord(RefPt,3)-Zone(ZoneFound)%MaximumZ,4))//' m.')
ENDIF
ENDIF
ENDIF
RefPt = RefPt + 1
END DO ! X
END DO ! Y
END IF
END IF
END DO ! MapNum
END DO
ALLOCATE(ZoneMsgDone(NumOfZones))
ZoneMsgDone=.false.
DO MapNum = 1, TotIllumMaps
IF (IllumMap(MapNum)%Zone == 0) CYCLE
IF (ZoneDaylight(IllumMap(MapNum)%Zone)%DaylightType /= DetailedDaylighting .and. &
.not. ZoneMsgDone(IllumMap(MapNum)%Zone)) THEN
CALL ShowSevereError('Zone Name in Output:IlluminanceMap is not used for Daylighting:Controls='// &
TRIM(Zone(IllumMap(MapNum)%Zone)%Name))
ErrorsFound = .TRUE.
ENDIF
ENDDO
DEALLOCATE(ZoneMsgDone)
IF (TotIllumMaps > 0) THEN
Write(OutputFileInits,'(A)') &
'! <Daylighting:Illuminance Maps:Detail>,Name,Zone,XMin {m},XMax {m},Xinc {m},#X Points,'// &
'YMin {m},YMax {m},Yinc {m},#Y Points,Z {m}'
ENDIF
DO MapNum = 1, TotIllumMaps
WRITE(OutputFileInits,"('Daylighting:Illuminance Maps:Detail',11(',',A))") TRIM(IllumMap(MapNum)%Name), &
TRIM(Zone(IllumMap(MapNum)%Zone)%Name), &
TRIM(RoundSigDigits(IllumMap(MapNum)%XMin,2)),TRIM(RoundSigDigits(IllumMap(MapNum)%XMax,2)), &
TRIM(RoundSigDigits(IllumMap(MapNum)%Xinc,2)),TRIM(RoundSigDigits(IllumMap(MapNum)%XNum)), &
TRIM(RoundSigDigits(IllumMap(MapNum)%YMin,2)),TRIM(RoundSigDigits(IllumMap(MapNum)%YMax,2)), &
TRIM(RoundSigDigits(IllumMap(MapNum)%Yinc,2)),TRIM(RoundSigDigits(IllumMap(MapNum)%YNum)), &
TRIM(RoundSigDigits(IllumMap(MapNum)%Z,2))
ENDDO
IF (ErrorsFound) RETURN
DO ZoneNum = 1, NumOfZones
IF (ZoneDaylight(ZoneNum)%TotalDaylRefPoints == 0) CYCLE
IF (ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 0) THEN
CALL SetupOutputVariable('Daylighting Reference Point 1 Illuminance [lux]', &
ZoneDaylight(ZoneNum)%DaylIllumAtRefPt(1), 'Zone', 'Average', &
Zone(ZoneNum)%Name)
CALL SetupOutputVariable('Daylighting Reference Point 1 Glare Index []', &
ZoneDaylight(ZoneNum)%GlareIndexAtRefPt(1), 'Zone', 'Average', &
Zone(ZoneNum)%Name)
!added TH 12/2/2008 to calculate the time exceeding the glare index setpoint
CALL SetupOutputVariable('Daylighting Reference Point 1 Glare Index Setpoint Exceeded Time [hr]', &
ZoneDaylight(ZoneNum)%TimeExceedingGlareIndexSPAtRefPt(1), 'Zone', 'Sum', Zone(ZoneNum)%Name)
!added TH 7/6/2009 to calculate the time exceeding the illuminance setpoint
CALL SetupOutputVariable('Daylighting Reference Point 1 Daylight Illuminance Setpoint Exceeded Time [hr]', &
ZoneDaylight(ZoneNum)%TimeExceedingDaylightIlluminanceSPAtRefPt(1), 'Zone', 'Sum', Zone(ZoneNum)%Name)
ENDIF
IF (ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 1) THEN
CALL SetupOutputVariable('Daylighting Reference Point 2 Illuminance [lux]', &
ZoneDaylight(ZoneNum)%DaylIllumAtRefPt(2), 'Zone', 'Average', &
Zone(ZoneNum)%Name)
CALL SetupOutputVariable('Daylighting Reference Point 2 Glare Index []', &
ZoneDaylight(ZoneNum)%GlareIndexAtRefPt(2), 'Zone', 'Average', &
Zone(ZoneNum)%Name)
!added TH 12/2/2008 to calculate the time exceeding the glare index setpoint
CALL SetupOutputVariable('Daylighting Reference Point 2 Glare Index Setpoint Exceeded Time [hr]', &
ZoneDaylight(ZoneNum)%TimeExceedingGlareIndexSPAtRefPt(2), 'Zone', 'Sum', Zone(ZoneNum)%Name)
!added TH 7/6/2009 to calculate the time exceeding the illuminance setpoint
CALL SetupOutputVariable('Daylighting Reference Point 2 Daylight Illuminance Setpoint Exceeded Time [hr]', &
ZoneDaylight(ZoneNum)%TimeExceedingDaylightIlluminanceSPAtRefPt(2), 'Zone', 'Sum', Zone(ZoneNum)%Name)
END IF
CALL SetupOutputVariable('Daylighting Lighting Power Multiplier []', &
ZoneDaylight(ZoneNum)%ZonePowerReductionFactor, 'Zone', 'Average', &
Zone(ZoneNum)%Name)
END DO
DO SurfLoop = 1,TotSurfaces
IF(Surface(SurfLoop)%Class == SurfaceClass_Window .AND. Surface(SurfLoop)%ExtSolar) THEN
IF(ZoneDaylight(Surface(SurfLoop)%Zone)%TotalDaylRefPoints > 0 .AND. &
.NOT. Zone(Surface(SurfLoop)%Zone)%HasInterZoneWindow) THEN
CALL SetupOutputVariable('Daylighting Window Reference Point 1 Illuminance [lux]', &
SurfaceWindow(SurfLoop)%IllumFromWinAtRefPt1Rep, &
'Zone', 'Average',Surface(SurfLoop)%Name)
CALL SetupOutputVariable('Daylighting Window Reference Point 1 View Luminance [cd/m2]', &
SurfaceWindow(SurfLoop)%LumWinFromRefPt1Rep, &
'Zone', 'Average',Surface(SurfLoop)%Name)
IF (ZoneDaylight(Surface(SurfLoop)%Zone)%TotalDaylRefPoints > 1) THEN
CALL SetupOutputVariable('Daylighting Window Reference Point 2 Illuminance [lux]', &
SurfaceWindow(SurfLoop)%IllumFromWinAtRefPt2Rep, &
'Zone', 'Average',Surface(SurfLoop)%Name)
CALL SetupOutputVariable('Daylighting Window Reference Point 2 View Luminance [cd/m2]', &
SurfaceWindow(SurfLoop)%LumWinFromRefPt2Rep, &
'Zone', 'Average',Surface(SurfLoop)%Name)
END IF
END IF
END IF
END DO
RETURN
END SUBROUTINE GetDaylightingParametersDetaild