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 ReportOrphanRecordObjects
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN August 2002
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reports "orphan" objects that are in the IDF but were
! not "gotten" during the simulation.
! METHODOLOGY EMPLOYED:
! Uses internal (to InputProcessor) IDFRecordsGotten array, cross-matched with Object
! names -- puts those into array to be printed (not adding dups).
! REFERENCES:
! na
! USE STATEMENTS:
! na
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:
! na
CHARACTER(len=MaxAlphaArgLength), ALLOCATABLE, DIMENSION(:) :: OrphanObjectNames
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: OrphanNames
INTEGER Count
INTEGER Found
INTEGER ObjFound
INTEGER NumOrphObjNames
ALLOCATE(OrphanObjectNames(NumIDFRecords),OrphanNames(NumIDFRecords))
OrphanObjectNames=Blank
OrphanNames=Blank
NumOrphObjNames=0
DO Count=1,NumIDFRecords
IF (IDFRecordsGotten(Count)) CYCLE
! This one not gotten
Found=FindIteminList(IDFRecords(Count)%Name,OrphanObjectNames,NumOrphObjNames)
IF (Found == 0) THEN
IF (SortedIDD) THEN
ObjFound=FindItemInSortedList(IDFRecords(Count)%Name,ListOfObjects,NumObjectDefs)
IF (ObjFound /= 0) ObjFound=iListofObjects(ObjFound)
ELSE
ObjFound=FindItemInList(IDFRecords(Count)%Name,ListOfObjects,NumObjectDefs)
ENDIF
IF (ObjFound > 0) THEN
IF (ObjectDef(ObjFound)%ObsPtr > 0) CYCLE ! Obsolete object, don't report "orphan"
NumOrphObjNames=NumOrphObjNames+1
OrphanObjectNames(NumOrphObjNames)=IDFRecords(Count)%Name
IF (ObjectDef(ObjFound)%NameAlpha1) THEN
OrphanNames(NumOrphObjNames)=IDFRecords(Count)%Alphas(1)
ENDIF
ELSE
CALL ShowWarningError('object not found='//trim(IDFRecords(Count)%Name))
ENDIF
ELSEIF (DisplayAllWarnings) THEN
IF (SortedIDD) THEN
ObjFound=FindItemInSortedList(IDFRecords(Count)%Name,ListOfObjects,NumObjectDefs)
IF (ObjFound /= 0) ObjFound=iListofObjects(ObjFound)
ELSE
ObjFound=FindItemInList(IDFRecords(Count)%Name,ListOfObjects,NumObjectDefs)
ENDIF
IF (ObjFound > 0) THEN
IF (ObjectDef(ObjFound)%ObsPtr > 0) CYCLE ! Obsolete object, don't report "orphan"
NumOrphObjNames=NumOrphObjNames+1
OrphanObjectNames(NumOrphObjNames)=IDFRecords(Count)%Name
IF (ObjectDef(ObjFound)%NameAlpha1) THEN
OrphanNames(NumOrphObjNames)=IDFRecords(Count)%Alphas(1)
ENDIF
ELSE
CALL ShowWarningError('ReportOrphanRecordObjects: object not found='//trim(IDFRecords(Count)%Name))
ENDIF
ENDIF
ENDDO
IF (NumOrphObjNames > 0 .and. DisplayUnusedObjects) THEN
WRITE(EchoInputFile,*) 'Unused Objects -- Objects in IDF that were never "gotten"'
DO Count=1,NumOrphObjNames
IF (OrphanNames(Count) /= Blank) THEN
WRITE(EchoInputFile,fmta) ' '//TRIM(OrphanObjectNames(Count))//'='//TRIM(OrphanNames(Count))
ELSE
WRITE(EchoInputFile,*) TRIM(OrphanObjectNames(Count))
ENDIF
ENDDO
CALL ShowWarningError('The following lines are "Unused Objects". These objects are in the idf')
CALL ShowContinueError(' file but are never obtained by the simulation and therefore are NOT used.')
IF (.not. DisplayAllWarnings) THEN
CALL ShowContinueError(' Only the first unused named object of an object class is shown. '// &
'Use Output:Diagnostics,DisplayAllWarnings to see all.')
ELSE
CALL ShowContinueError(' Each unused object is shown.')
ENDIF
CALL ShowContinueError(' See InputOutputReference document for more details.')
IF (OrphanNames(1) /= Blank) THEN
CALL ShowMessage('Object='//TRIM(OrphanObjectNames(1))//'='//TRIM(OrphanNames(1)))
ELSE
CALL ShowMessage('Object='//TRIM(OrphanObjectNames(1)))
ENDIF
DO Count=2,NumOrphObjNames
IF (OrphanNames(Count) /= Blank) THEN
CALL ShowContinueError('Object='//TRIM(OrphanObjectNames(Count))//'='//TRIM(OrphanNames(Count)))
ELSE
CALL ShowContinueError('Object='//TRIM(OrphanObjectNames(Count)))
ENDIF
ENDDO
ELSEIF (NumOrphObjNames > 0) THEN
CALL ShowMessage('There are '//trim(IPTrimSigDigits(NumOrphObjNames))//' unused objects in input.')
CALL ShowMessage('Use Output:Diagnostics,DisplayUnusedObjects; to see them.')
ENDIF
DEALLOCATE(OrphanObjectNames)
DEALLOCATE(OrphanNames)
RETURN
END SUBROUTINE ReportOrphanRecordObjects