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.
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 ProduceRDDMDD
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! provide a single call for writing out the Report Data Dictionary and Meter Data Dictionary.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataStringGlobals, ONLY: VerString,IDDVerString
USE InputProcessor, ONLY: SameString,FindItemInList
USE OutputProcessor
USE SortAndStringUtilities, ONLY: SetupAndSort
USE General, ONLY: ScanForReports
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: RealType=1
INTEGER, PARAMETER :: IntegerType=2
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
TYPE VariableTypes
INTEGER :: RealIntegerType=0 ! Real= 1, Integer=2
INTEGER :: VarPtr=0 ! pointer to real/integer VariableTypes structures
INTEGER :: IndexType=0
INTEGER :: StoreType=0
CHARACTER(len=UnitsStringLength) :: UnitsString=' '
END TYPE
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER, EXTERNAL :: GetNewUnitNumber
CHARACTER(len=MaxNameLength) :: VarOption1
CHARACTER(len=MaxNameLength) :: VarOption2
LOGICAL DoReport
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: VariableNames
INTEGER, ALLOCATABLE, DIMENSION(:) :: iVariableNames
INTEGER :: Item
LOGICAL :: SortByName
INTEGER :: ItemPtr
INTEGER :: write_stat
! See if Report Variables should be turned on
SortByName=.false.
CALL ScanForReports('VariableDictionary',DoReport,Option1=VarOption1,Option2=VarOption2)
! IF (.not. DoReport) RETURN
IF (DoReport) THEN
ProduceReportVDD=ReportVDD_Yes
IF (VarOption1 == 'IDF') THEN
ProduceReportVDD=ReportVDD_IDF
ENDIF
IF (VarOption2 /= ' ') THEN
IF (SameString(VarOption2,'Name') .or. SameString(VarOption2,'AscendingName')) THEN
SortByName=.true.
ENDIF
ENDIF
ENDIF
IF (ProduceReportVDD == ReportVDD_Yes) THEN
OutputFileRVDD=GetNewUnitNumber()
OPEN(OutputFileRVDD,File='eplusout.rdd', Action='write', iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('ProduceRDDMDD: Could not open file "eplusout.rdd" for output (write).')
ENDIF
WRITE(OutputFileRVDD,fmta) 'Program Version,'//TRIM(VerString)//','//TRIM(IDDVerString)
WRITE(OutputFileRVDD,fmta) 'Var Type (reported time step),Var Report Type,Variable Name [Units]'
OutputFileMVDD=GetNewUnitNumber()
OPEN(OutputFileMVDD,File='eplusout.mdd', Action='write', iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('ProduceRDDMDD: Could not open file "eplusout.mdd" for output (write).')
ENDIF
WRITE(OutputFileMVDD,fmta) 'Program Version,'//TRIM(VerString)//','//TRIM(IDDVerString)
WRITE(OutputFileMVDD,fmta) 'Var Type (reported time step),Var Report Type,Variable Name [Units]'
ELSEIF (ProduceReportVDD == ReportVDD_IDF) THEN
OutputFileRVDD=GetNewUnitNumber()
OPEN(OutputFileRVDD,File='eplusout.rdd', Action='write', iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('ProduceRDDMDD: Could not open file "eplusout.rdd" for output (write).')
ENDIF
WRITE(OutputFileRVDD,fmta) '! Program Version,'//TRIM(VerString)//','//TRIM(IDDVerString)
WRITE(OutputFileRVDD,fmta) '! Output:Variable Objects (applicable to this run)'
OutputFileMVDD=GetNewUnitNumber()
OPEN(OutputFileMVDD,File='eplusout.mdd', Action='write', iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('ProduceRDDMDD: Could not open file "eplusout.mdd" for output (write).')
ENDIF
WRITE(OutputFileMVDD,fmta) '! Program Version,'//TRIM(VerString)//','//TRIM(IDDVerString)
WRITE(OutputFileMVDD,fmta) '! Output:Meter Objects (applicable to this run)'
ENDIF
ALLOCATE(VariableNames(NumVariablesForOutput))
VariableNames(1:NumVariablesForOutput)=DDVariableTypes(1:NumVariablesForOutput)%VarNameOnly
ALLOCATE(iVariableNames(NumVariablesForOutput))
iVariableNames=0
IF (SortByName) THEN
CALL SetupAndSort(VariableNames,iVariableNames)
ELSE
DO Item=1,NumVariablesForOutput
iVariableNames(Item)=Item
ENDDO
ENDIF
DO Item=1,NumVariablesForOutput
IF (ProduceReportVDD == ReportVDD_Yes) THEN
ItemPtr=iVariableNames(Item)
IF (.not. DDVariableTypes(ItemPtr)%ReportedOnDDFile) THEN
WRITE(OutputFileRVDD,fmta) trim(StandardIndexTypeKey(DDVariableTypes(ItemPtr)%IndexType))//','// &
trim(StandardVariableTypeKey(DDVariableTypes(ItemPtr)%StoreType))//','// &
trim(VariableNames(Item))// &
' ['//trim(DDVariableTypes(ItemPtr)%UnitsString)//']'
DDVariableTypes(ItemPtr)%ReportedOnDDFile=.true.
DO WHILE (DDVariableTypes(ItemPtr)%Next /= 0)
IF (SortByName) THEN
ItemPtr=ItemPtr+1
ELSE
ItemPtr=DDVariableTypes(ItemPtr)%Next
ENDIF
WRITE(OutputFileRVDD,fmta) trim(StandardIndexTypeKey(DDVariableTypes(ItemPtr)%IndexType))//','// &
trim(StandardVariableTypeKey(DDVariableTypes(ItemPtr)%StoreType))//','// &
trim(VariableNames(Item))// &
' ['//trim(DDVariableTypes(ItemPtr)%UnitsString)//']'
DDVariableTypes(ItemPtr)%ReportedOnDDFile=.true.
ENDDO
ENDIF
ELSEIF (ProduceReportVDD == ReportVDD_IDF) THEN
ItemPtr=iVariableNames(Item)
IF (.not. DDVariableTypes(ItemPtr)%ReportedOnDDFile) THEN
WRITE(OutputFileRVDD,fmta) 'Output:Variable,*,'//trim(VariableNames(Item))// &
',hourly; !- '//trim(StandardIndexTypeKey(DDVariableTypes(ItemPtr)%IndexType))//' '// &
trim(StandardVariableTypeKey(DDVariableTypes(ItemPtr)%StoreType))// &
' ['//trim(DDVariableTypes(ItemPtr)%UnitsString)//']'
DDVariableTypes(ItemPtr)%ReportedOnDDFile=.true.
DO WHILE (DDVariableTypes(ItemPtr)%Next /= 0)
IF (SortByName) THEN
ItemPtr=ItemPtr+1
ELSE
ItemPtr=DDVariableTypes(ItemPtr)%Next
ENDIF
WRITE(OutputFileRVDD,fmta) 'Output:Variable,*,'//trim(VariableNames(Item))// &
',hourly; !- '//trim(StandardIndexTypeKey(DDVariableTypes(ItemPtr)%IndexType))//' '// &
trim(StandardVariableTypeKey(DDVariableTypes(ItemPtr)%StoreType))// &
' ['//trim(DDVariableTypes(ItemPtr)%UnitsString)//']'
DDVariableTypes(ItemPtr)%ReportedOnDDFile=.true.
ENDDO
ENDIF
ENDIF
ENDDO
DEALLOCATE(VariableNames)
DEALLOCATE(iVariableNames)
! Now EnergyMeter variables
IF (SortByName) THEN
ALLOCATE(VariableNames(NumEnergyMeters))
DO Item=1,NumEnergyMeters
VariableNames(Item)=EnergyMeters(Item)%Name
ENDDO
ALLOCATE(iVariableNames(NumEnergyMeters))
iVariableNames=0
CALL SetupAndSort(VariableNames,iVariableNames)
ELSE
ALLOCATE(VariableNames(NumEnergyMeters))
ALLOCATE(iVariableNames(NumEnergyMeters))
iVariableNames=0
DO Item=1,NumEnergyMeters
VariableNames(Item)=EnergyMeters(Item)%Name
iVariableNames(Item)=Item
ENDDO
ENDIF
DO Item=1,NumEnergyMeters
ItemPtr=iVariableNames(Item)
IF (ProduceReportVDD == ReportVDD_Yes) THEN
WRITE(OutputFileMVDD,fmta) 'Zone,Meter,'//trim(EnergyMeters(ItemPtr)%Name)//' ['//trim(EnergyMeters(ItemPtr)%Units)//']'
ELSEIF (ProduceReportVDD == ReportVDD_IDF) THEN
WRITE(OutputFileMVDD,fmta) 'Output:Meter,'//trim(EnergyMeters(ItemPtr)%Name)//',hourly; !- ['// &
trim(EnergyMeters(ItemPtr)%Units)//']'
WRITE(OutputFileMVDD,fmta) 'Output:Meter:Cumulative,'//trim(EnergyMeters(ItemPtr)%Name)//',hourly; !- ['// &
trim(EnergyMeters(ItemPtr)%Units)//']'
ENDIF
ENDDO
DEALLOCATE(VariableNames)
DEALLOCATE(iVariableNames)
! DEALLOCATE(DDVariableTypes)
RETURN
END SUBROUTINE ProduceRDDMDD