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 CloseReportIllumMaps
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN June 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine "closes" out the created daylight illuminance maps by merging them
! into the "eplusout.map" file.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataStringGlobals, ONLY: CharTab, CharComma, CharSpace
USE General, ONLY: TrimSigDigits
USE DataErrorTracking, ONLY: AbortProcessing
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: FmtA="(A)"
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER, SAVE :: MapOutputFile
INTEGER, EXTERNAL :: GetNewUnitNumber
INTEGER :: MapNum
INTEGER :: ios=0
INTEGER :: NumLines
IF (TotIllumMaps > 0) THEN
MapOutputFile=GetNewUnitNumber() ! can add this to DataGlobals with the others...
! Write map header
IF (MapColSep == CharTab) THEN
OPEN(UNIT=MapOutputFile,FILE='eplusmap.tab',STATUS='UNKNOWN',ACTION='write',ERR=901)
ELSEIF (MapColSep == CharComma) THEN
OPEN(UNIT=MapOutputFile,FILE='eplusmap.csv',STATUS='UNKNOWN',ACTION='write',ERR=902)
ELSE
OPEN(UNIT=MapOutputFile,FILE='eplusmap.txt',STATUS='UNKNOWN',ACTION='write',ERR=903)
ENDIF
DO MapNum=1,TotIllumMaps
IF (IllumMap(MapNum)%UnitNo == 0) CYCLE ! fatal error processing
NumLines=0
REWIND(IllumMap(MapNum)%UnitNo)
ios=0
DO WHILE (ios == 0)
READ(IllumMap(MapNum)%UnitNo,FmtA,IOSTAT=ios) mapLine
IF (ios > 0) THEN ! usually a read error
CALL ShowFatalError('CloseReportIllumMaps: Failed to read map. IOError='//trim(TrimSigDigits(ios)))
ELSEIF (ios /= 0) THEN
IF (NumLines == 0) THEN
CALL ShowSevereError('CloseReportIllumMaps: IllumMap="'//trim(IllumMap(MapNum)%Name)//'" is empty.')
ENDIF
EXIT
ENDIF
NumLines=NumLines+1
WRITE(MapOutputFile,FmtA) TRIM(mapLine)
ENDDO
CLOSE(IllumMap(MapNum)%UnitNo,STATUS='DELETE')
ENDDO
IF (.not. mapResultsReported .and. .not. AbortProcessing) THEN
CALL ShowSevereError('CloseReportIllumMaps: Illuminance maps requested but no data ever reported. '// &
'Likely cause is no solar.')
WRITE(MapOutputFile,FmtA) 'CloseReportIllumMaps: Illuminance maps requested but no data ever reported. '// &
'Likely cause is no solar.'
ENDIF
CLOSE(MapOutputFile)
ENDIF
RETURN
901 CALL ShowFatalError('CloseReportIllumMaps: Could not open file "eplusmap.tab" for output (write).')
RETURN
902 CALL ShowFatalError('CloseReportIllumMaps: Could not open file "eplusmap.csv" for output (write).')
RETURN
903 CALL ShowFatalError('CloseReportIllumMaps: Could not open file "eplusmap.txt" for output (write).')
RETURN
END SUBROUTINE CloseReportIllumMaps