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 ReportOrphanSchedules
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN April 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! In response to CR7498, report orphan (unused) schedule items.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: DisplayUnusedSchedules
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: NeedOrphanMessage
LOGICAL :: NeedUseMessage
INTEGER :: Item
INTEGER :: NumCount
NeedOrphanMessage=.true.
NeedUseMessage=.false.
NumCount=0
DO Item=1,NumSchedules
IF (Schedule(Item)%Used) CYCLE
IF (NeedOrphanMessage .and. DisplayUnusedSchedules) THEN
CALL ShowWarningError('The following schedule names are "Unused Schedules". These schedules are in the idf')
CALL ShowContinueError(' file but are never obtained by the simulation and therefore are NOT used.')
NeedOrphanMessage=.false.
ENDIF
IF (DisplayUnusedSchedules) THEN
CALL ShowMessage('Schedule:Year or Schedule:Compact or Schedule:File or Schedule:Constant='//TRIM(Schedule(Item)%Name))
ELSE
NumCount=NumCount+1
ENDIF
ENDDO
IF (NumCount > 0) THEN
CALL ShowMessage('There are '//trim(RoundSigDigits(NumCount))//' unused schedules in input.')
NeedUseMessage=.true.
ENDIF
NeedOrphanMessage=.true.
NumCount=0
DO Item=1,NumWeekSchedules
IF (WeekSchedule(Item)%Used) CYCLE
IF (WeekSchedule(Item)%Name == Blank) CYCLE
IF (NeedOrphanMessage .and. DisplayUnusedSchedules) THEN
CALL ShowWarningError('The following week schedule names are "Unused Schedules". These schedules are in the idf')
CALL ShowContinueError(' file but are never obtained by the simulation and therefore are NOT used.')
NeedOrphanMessage=.false.
ENDIF
IF (DisplayUnusedSchedules) THEN
CALL ShowMessage('Schedule:Week:Daily or Schedule:Week:Compact='//TRIM(WeekSchedule(Item)%Name))
ELSE
NumCount=NumCount+1
ENDIF
ENDDO
IF (NumCount > 0) THEN
CALL ShowMessage('There are '//trim(RoundSigDigits(NumCount))//' unused week schedules in input.')
NeedUseMessage=.true.
ENDIF
NeedOrphanMessage=.true.
NumCount=0
DO Item=1,NumDaySchedules
IF (DaySchedule(Item)%Used) CYCLE
IF (DaySchedule(Item)%Name == Blank) CYCLE
IF (NeedOrphanMessage .and. DisplayUnusedSchedules) THEN
CALL ShowWarningError('The following day schedule names are "Unused Schedules". These schedules are in the idf')
CALL ShowContinueError(' file but are never obtained by the simulation and therefore are NOT used.')
NeedOrphanMessage=.false.
ENDIF
IF (DisplayUnusedSchedules) THEN
CALL ShowMessage('Schedule:Day:Hourly or Schedule:Day:Interval or Schedule:Day:List='//TRIM(DaySchedule(Item)%Name))
ELSE
NumCount=NumCount+1
ENDIF
ENDDO
IF (NumCount > 0) THEN
CALL ShowMessage('There are '//trim(RoundSigDigits(NumCount))//' unused day schedules in input.')
NeedUseMessage=.true.
ENDIF
IF (NeedUseMessage) CALL ShowMessage('Use Output:Diagnostics,DisplayUnusedSchedules; to see them.')
RETURN
END SUBROUTINE ReportOrphanSchedules