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 ReportSurfaceErrors
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN November 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reports some recurring type errors that can get mixed up with more important
! errors in the error file.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataErrorTracking ! for error tracking
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=8), PARAMETER, DIMENSION(4) :: MSG = (/'misses ',' ','within ','overlaps'/)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Loop1
INTEGER Loop2
INTEGER Count
INTEGER TotCount
CHARACTER(len=25) CountOut
LOGICAL, ALLOCATABLE, DIMENSION(:) :: SurfErrorReported
LOGICAL, ALLOCATABLE, DIMENSION(:) :: SurfErrorReported2
IF (NumTooManyFigures+NumTooManyVertices+NumBaseSubSurround > 0) THEN
CALL ShowMessage(' ')
CALL ShowMessage('===== Recurring Surface Error Summary =====')
CALL ShowMessage('The following surface error messages occurred.')
CALL ShowMessage(' ')
IF (NumBaseSubSurround > 0) THEN
CALL ShowMessage('Base Surface does not surround subsurface errors occuring...')
CALL ShowMessage('Check that the GlobalGeometryRules object is expressing the proper starting corner and '// &
'direction [CounterClockwise/Clockwise]')
CALL ShowMessage(' ')
ENDIF
ALLOCATE(SurfErrorReported(TotSurfaces))
SurfErrorReported=.false.
TotCount=0
DO Loop1=1,NumBaseSubSurround
Count=0
IF (SurfErrorReported(TrackBaseSubSurround(Loop1)%SurfIndex1)) CYCLE
DO Loop2=1,NumBaseSubSurround
IF (TrackBaseSubSurround(Loop1)%SurfIndex1 == TrackBaseSubSurround(Loop2)%SurfIndex1 .and. &
TrackBaseSubSurround(Loop1)%MiscIndex == TrackBaseSubSurround(Loop2)%MiscIndex) THEN
Count=Count+1
ENDIF
ENDDO
WRITE(CountOut,*) Count
TotCount=TotCount+Count
TotalWarningErrors=TotalWarningErrors+Count-1
CALL ShowWarningError('Base surface does not surround subsurface (CHKSBS), Overlap Status='// &
TRIM(cOverLapStatus(TrackBaseSubSurround(Loop1)%MiscIndex)))
CALL ShowContinueError(' The base surround errors occurred '//TRIM(ADJUSTL(CountOut))//' times.')
DO Loop2=1,NumBaseSubSurround
IF (TrackBaseSubSurround(Loop1)%SurfIndex1 == TrackBaseSubSurround(Loop2)%SurfIndex1 .and. &
TrackBaseSubSurround(Loop1)%MiscIndex == TrackBaseSubSurround(Loop2)%MiscIndex) THEN
CALL ShowContinueError('Surface "'//TRIM(Surface(TrackBaseSubSurround(Loop1)%SurfIndex1)%Name)// &
'" '//TRIM(MSG(TrackBaseSubSurround(Loop1)%MiscIndex))// &
' SubSurface "'//TRIM(Surface(TrackBaseSubSurround(Loop2)%SurfIndex2)%Name)//'"')
ENDIF
ENDDO
SurfErrorReported(TrackBaseSubSurround(Loop1)%SurfIndex1)=.true.
ENDDO
IF (TotCount > 0) THEN
CALL ShowMessage(' ')
WRITE(CountOut,*) TotCount
CALL ShowContinueError(' The base surround errors occurred '//TRIM(ADJUSTL(CountOut))//' times (total).')
CALL ShowMessage(' ')
ENDIF
ALLOCATE(SurfErrorReported2(TotSurfaces))
SurfErrorReported=.false.
TotCount=0
IF (NumTooManyVertices > 0) THEN
CALL ShowMessage('Too many vertices [>='// &
TRIM(RoundSigDigits(MaxHCV))//'] in shadow overlap errors occurring...')
CALL ShowMessage('These occur throughout the year and may occur several times for the same surfaces. '// &
'You may be able to reduce them by adding Output:Diagnostics,DoNotMirrorDetachedShading;')
ENDIF
DO Loop1=1,NumTooManyVertices
Count=0
SurfErrorReported2=.false.
IF (SurfErrorReported(TrackTooManyVertices(Loop1)%SurfIndex1)) CYCLE
DO Loop2=1,NumTooManyVertices
IF (TrackTooManyVertices(Loop1)%SurfIndex1 == TrackTooManyVertices(Loop2)%SurfIndex1) THEN
Count=Count+1
ENDIF
ENDDO
WRITE(CountOut,*) Count
TotCount=TotCount+Count
TotalWarningErrors=TotalWarningErrors+Count-1
CALL ShowMessage(' ')
CALL ShowWarningError('Too many vertices [>='// &
TRIM(RoundSigDigits(MaxHCV))//'] in a shadow overlap')
CALL ShowContinueError('Overlapping figure='//TRIM(Surface(TrackTooManyVertices(Loop1)%SurfIndex1)%Name)// &
', Surface Class=['//TRIM(cSurfaceClass(Surface(TrackTooManyVertices(Loop1)%SurfIndex1)%Class))//']')
CALL ShowContinueError(' This error occurred '//TRIM(ADJUSTL(CountOut))//' times.')
DO Loop2=1,NumTooManyVertices
IF (TrackTooManyVertices(Loop1)%SurfIndex1 == TrackTooManyVertices(Loop2)%SurfIndex1) THEN
IF (SurfErrorReported2(TrackTooManyVertices(Loop2)%SurfIndex2)) CYCLE
CALL ShowContinueError('Figure being Overlapped='//TRIM(Surface(TrackTooManyVertices(Loop2)%SurfIndex2)%Name)// &
', Surface Class=['//TRIM(cSurfaceClass(Surface(TrackTooManyVertices(Loop2)%SurfIndex2)%Class))//']')
SurfErrorReported2(TrackTooManyVertices(Loop2)%SurfIndex2)=.true.
ENDIF
ENDDO
SurfErrorReported(TrackTooManyVertices(Loop1)%SurfIndex1)=.true.
ENDDO
IF (TotCount > 0) THEN
CALL ShowMessage(' ')
WRITE(CountOut,*) TotCount
CALL ShowContinueError(' The too many vertices errors occurred '//TRIM(ADJUSTL(CountOut))//' times (total).')
CALL ShowMessage(' ')
ENDIF
SurfErrorReported=.false.
TotCount=0
IF (NumTooManyFigures > 0) THEN
CALL ShowMessage('Too many figures [>='// &
TRIM(RoundSigDigits(MaxHCS))//'] in shadow overlap errors occurring...')
CALL ShowMessage('These occur throughout the year and may occur several times for the same surfaces. '// &
'You may be able to reduce them by adding OutputDiagnostics,DoNotMirrorDetachedShading;')
ENDIF
DO Loop1=1,NumTooManyFigures
Count=0
SurfErrorReported2=.false.
IF (SurfErrorReported(TrackTooManyFigures(Loop1)%SurfIndex1)) CYCLE
DO Loop2=1,NumTooManyFigures
IF (TrackTooManyFigures(Loop1)%SurfIndex1 == TrackTooManyFigures(Loop2)%SurfIndex1) THEN
Count=Count+1
ENDIF
ENDDO
WRITE(CountOut,*) Count
TotCount=TotCount+Count
TotalWarningErrors=TotalWarningErrors+Count-1
CALL ShowMessage(' ')
CALL ShowWarningError('Too many figures [>='// &
TRIM(RoundSigDigits(MaxHCS))//'] in a shadow overlap')
CALL ShowContinueError('Overlapping figure='//TRIM(Surface(TrackTooManyFigures(Loop1)%SurfIndex1)%Name)// &
', Surface Class=['//TRIM(cSurfaceClass(Surface(TrackTooManyFigures(Loop1)%SurfIndex1)%Class))//']')
CALL ShowContinueError(' This error occurred '//TRIM(ADJUSTL(CountOut))//' times.')
DO Loop2=1,NumTooManyFigures
IF (TrackTooManyFigures(Loop1)%SurfIndex1 == TrackTooManyFigures(Loop2)%SurfIndex1) THEN
IF (SurfErrorReported2(TrackTooManyFigures(Loop2)%SurfIndex2)) CYCLE
CALL ShowContinueError('Figure being Overlapped='//TRIM(Surface(TrackTooManyFigures(Loop2)%SurfIndex2)%Name)// &
', Surface Class=['//TRIM(cSurfaceClass(Surface(TrackTooManyFigures(Loop2)%SurfIndex2)%Class))//']')
SurfErrorReported2(TrackTooManyFigures(Loop2)%SurfIndex2)=.true.
ENDIF
ENDDO
SurfErrorReported(TrackTooManyFigures(Loop1)%SurfIndex1)=.true.
ENDDO
IF (TotCount > 0) THEN
CALL ShowMessage(' ')
WRITE(CountOut,*) TotCount
CALL ShowContinueError(' The too many figures errors occurred '//TRIM(ADJUSTL(CountOut))//' times (total).')
CALL ShowMessage(' ')
ENDIF
DEALLOCATE(SurfErrorReported)
DEALLOCATE(SurfErrorReported2)
ENDIF
RETURN
END SUBROUTINE ReportSurfaceErrors