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.
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 OpenOutputTabularFile
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN July 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Create a file that holds the output from the tabular reports
! the output is in a CSV file if it is comma delimited otherwise
! it is in a TXT file.
! METHODOLOGY EMPLOYED:
! Uses get input structure similar to other objects
! REFERENCES:
! na
! USE STATEMENTS:
USE DataStringGlobals, ONLY : VerString
USE DataEnvironment, ONLY : EnvironmentName, WeatherFileLocationTitle
USE DataHeatBalance, ONLY : BuildingName
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: fmta="(A)"
CHARACTER(len=*), PARAMETER :: TimeStampFmt1="(A,I4,A,I2.2,A,I2.2)"
CHARACTER(len=*), PARAMETER :: TimeStampFmt2="(A,I2.2,A,I2.2,A,I2.2,A)"
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER,EXTERNAL :: GetNewUnitNumber ! Function to call if file not opened
INTEGER :: iStyle
INTEGER :: curFH !current file handle
CHARACTER(LEN=1) :: curDel
INTEGER :: write_stat
! get a new file unit number
! create a file to hold the results
! Use a CSV file if comma seperated but otherwise use TXT file
! extension.
IF (WriteTabularFiles) THEN
DO iStyle = 1, numStyles
TabularOutputFile(iStyle) = GetNewUnitNumber()
curFH = TabularOutputFile(iStyle)
curDel = del(iStyle)
IF (tableStyle(iStyle) .eq. tableStyleComma) THEN
CALL DisplayString('Writing tabular output file results using comma format.')
OPEN(UNIT=curFH,FILE='eplustbl.csv',action='WRITE',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('OpenOutputTabularFile: Could not open file "eplustbl.csv" for output (write).')
ENDIF
WRITE(curFH,fmta) 'Program Version:'// curDel //TRIM(VerString)
WRITE(curFH,*) 'Tabular Output Report in Format: '// curDel // 'Comma'
WRITE(curFH,fmta) ''
WRITE(curFH,fmta) 'Building:' // curDel //TRIM(BuildingName)
IF (EnvironmentName == WeatherFileLocationTitle) THEN
WRITE(curFH,fmta) 'Environment:' // curDel //TRIM(EnvironmentName)
ELSE
WRITE(curFH,fmta) 'Environment:' // curDel //TRIM(EnvironmentName)//' ** '//TRIM(WeatherFileLocationTitle)
ENDIF
WRITE(curFH,fmta) ''
ELSEIF (tableStyle(iStyle) .eq. tableStyleTab) THEN
CALL DisplayString('Writing tabular output file results using tab format.')
OPEN(curFH,FILE='eplustbl.tab',action='WRITE',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('OpenOutputTabularFile: Could not open file "eplustbl.tab" for output (write).')
ENDIF
WRITE(curFH,fmta) 'Program Version'// curDel //TRIM(VerString)
WRITE(curFH,fmta) 'Tabular Output Report in Format: '// curDel // 'Tab'
WRITE(curFH,fmta) ''
WRITE(curFH,fmta) 'Building:' // curDel //TRIM(BuildingName)
IF (EnvironmentName == WeatherFileLocationTitle) THEN
WRITE(curFH,fmta) 'Environment:' // curDel //TRIM(EnvironmentName)
ELSE
WRITE(curFH,fmta) 'Environment:' // curDel //TRIM(EnvironmentName)//' ** '//TRIM(WeatherFileLocationTitle)
ENDIF
WRITE(curFH,fmta) ''
ELSEIF (tableStyle(iStyle) .eq. tableStyleHTML) THEN
CALL DisplayString('Writing tabular output file results using HTML format.')
OPEN(curFH,FILE='eplustbl.htm',action='WRITE',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('OpenOutputTabularFile: Could not open file "eplustbl.htm" for output (write).')
ENDIF
WRITE(curFH,fmta) '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"' // &
'"http://www.w3.org/TR/html4/loose.dtd">'
WRITE(curFH,fmta) '<html>'
WRITE(curFH,fmta) '<head>'
IF (EnvironmentName == WeatherFileLocationTitle) THEN
WRITE(curFH,fmta) '<title> ' // TRIM(BuildingName) // ' ' // TRIM(EnvironmentName)
ELSE
WRITE(curFH,fmta) '<title> ' // TRIM(BuildingName) // ' ' // TRIM(EnvironmentName)//' ** '//TRIM(WeatherFileLocationTitle)
ENDIF
WRITE(curFH,TimeStampFmt1) ' ',td(1),'-', td(2),'-',td(3)
WRITE(curFH,TimeStampFmt2) ' ',td(5),':', td(6),':',td(7),' '
WRITE(curFH,fmta) ' - EnergyPlus</title>'
WRITE(curFH,fmta) '</head>'
WRITE(curFH,fmta) '<body>'
WRITE(curFH,fmta) '<p><a href="#toc" style="float: right">Table of Contents</a></p>'
WRITE(curFH,fmta) '<a name=top></a>'
WRITE(curFH,fmta) '<p>Program Version:<b>'// TRIM(VerString) // '</b></p>'
WRITE(curFH,fmta) '<p>Tabular Output Report in Format: <b>HTML</b></p>'
WRITE(curFH,fmta) '<p>Building: <b>' //TRIM(BuildingName) // '</b></p>'
IF (EnvironmentName == WeatherFileLocationTitle) THEN
WRITE(curFH,fmta) '<p>Environment: <b>' //TRIM(EnvironmentName) // '</b></p>'
ELSE
WRITE(curFH,fmta) '<p>Environment: <b>' //TRIM(EnvironmentName)//' ** '//TRIM(WeatherFileLocationTitle)// '</b></p>'
ENDIF
WRITE(curFH,TimeStampFmt1) "<p>Simulation Timestamp: <b>", td(1),'-', td(2),'-',td(3)
WRITE(curFH,TimeStampFmt2) ' ',td(5),':', td(6),':',td(7),'</b></p>'
ELSEIF (tableStyle(iStyle) .eq. tableStyleXML) THEN
CALL DisplayString('Writing tabular output file results using XML format.')
OPEN(curFH,FILE='eplustbl.xml',action='WRITE',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('OpenOutputTabularFile: Could not open file "eplustbl.xml" for output (write).')
ENDIF
WRITE(curFH,fmta) '<?xml version="1.0"?>'
WRITE(curFH,fmta) '<EnergyPlusTabularReports>'
WRITE(curFH,fmta) ' <BuildingName>' // TRIM(BuildingName) // '</BuildingName>'
WRITE(curFH,fmta) ' <EnvironmentName>' // TRIM(EnvironmentName) // '</EnvironmentName>'
WRITE(curFH,fmta) ' <WeatherFileLocationTitle>' //TRIM(WeatherFileLocationTitle) // '</WeatherFileLocationTitle>'
WRITE(curFH,fmta) ' <ProgramVersion>'// TRIM(VerString) // '</ProgramVersion>'
WRITE(curFH,fmta) ' <SimulationTimestamp>'
WRITE(curFH,fmta) ' <Date>'
WRITE(curFH,TimeStampFmt1) ' ', td(1),'-', td(2),'-',td(3)
WRITE(curFH,fmta) ' </Date>'
WRITE(curFH,fmta) ' <Time>'
WRITE(curFH,TimeStampFmt2) ' ',td(5),':', td(6),':',td(7),' '
WRITE(curFH,fmta) ' </Time>'
WRITE(curFH,fmta) ' </SimulationTimestamp>'
WRITE(curFH,fmta) ' '
ELSE
CALL DisplayString('Writing tabular output file results using text format.')
OPEN(curFH,File='eplustbl.txt', Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('OpenOutputTabularFile: Could not open file "eplustbl.txt" for output (write).')
ENDIF
WRITE(curFH,fmta) 'Program Version: ' //TRIM(VerString)
WRITE(curFH,fmta) 'Tabular Output Report in Format: '// curDel // 'Fixed'
WRITE(curFH,fmta) ''
WRITE(curFH,fmta) 'Building: ' //TRIM(BuildingName)
IF (EnvironmentName == WeatherFileLocationTitle) THEN
WRITE(curFH,fmta) 'Environment: ' //TRIM(EnvironmentName)
ELSE
WRITE(curFH,fmta) 'Environment: ' //TRIM(EnvironmentName)//' ** '//TRIM(WeatherFileLocationTitle)
ENDIF
WRITE(curFH,fmta) ''
END IF
END DO
END IF
END SUBROUTINE OpenOutputTabularFile