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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | PreP_Fatal |
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 PreProcessorCheck(PreP_Fatal)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN August 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine checks for existance of "Preprocessor Message" object and
! performs appropriate action.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Preprocessor Message,
! \memo This object does not come from a user input. This is generated by a pre-processor
! \memo so that various conditions can be gracefully passed on by the InputProcessor.
! A1, \field preprocessor name
! A2, \field error severity
! \note Depending on type, InputProcessor may terminate the program.
! \type choice
! \key warning
! \key severe
! \key fatal
! A3, \field message line 1
! A4, \field message line 2
! A5, \field message line 3
! A6, \field message line 4
! A7, \field message line 5
! A8, \field message line 6
! A9, \field message line 7
! A10, \field message line 8
! A11, \field message line 9
! A12; \field message line 10
! USE STATEMENTS:
USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: PreP_Fatal ! True if a preprocessor flags a fatal error
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumAlphas ! Used to retrieve names from IDF
INTEGER :: NumNumbers ! Used to retrieve rNumericArgs from IDF
INTEGER :: IOStat ! Could be used in the Get Routines, not currently checked
INTEGER :: NumParams ! Total Number of Parameters in 'Output:PreprocessorMessage' Object
INTEGER :: NumPrePM ! Number of Preprocessor Message objects in IDF
INTEGER :: CountP
INTEGER :: CountM
CHARACTER(len=1) :: Multiples
cCurrentModuleObject='Output:PreprocessorMessage'
NumPrePM=GetNumObjectsFound(cCurrentModuleObject)
IF (NumPrePM > 0) THEN
CALL GetObjectDefMaxArgs(cCurrentModuleObject,NumParams,NumAlphas,NumNumbers)
cAlphaArgs(1:NumAlphas)=Blank
DO CountP=1,NumPrePM
CALL GetObjectItem(cCurrentModuleObject,CountP,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (cAlphaArgs(1) == Blank) cAlphaArgs(1)='Unknown'
IF (NumAlphas > 3) THEN
Multiples='s'
ELSE
Multiples=Blank
ENDIF
IF (cAlphaArgs(2) == Blank) cAlphaArgs(2)='Unknown'
SELECT CASE (MakeUPPERCase(cAlphaArgs(2)))
CASE('INFORMATION')
CALL ShowMessage(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" has the following Information message'//TRIM(Multiples)//':')
CASE('WARNING')
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" has the following Warning condition'//TRIM(Multiples)//':')
CASE('SEVERE')
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" has the following Severe condition'//TRIM(Multiples)//':')
CASE('FATAL')
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" has the following Fatal condition'//TRIM(Multiples)//':')
PreP_Fatal=.true.
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'" has the following '//TRIM(cAlphaArgs(2))//' condition'//TRIM(Multiples)//':')
END SELECT
CountM=3
IF (CountM > NumAlphas) THEN
CALL ShowContinueError(TRIM(cCurrentModuleObject)//' was blank. Check '//TRIM(cAlphaArgs(1))// &
' audit trail or error file for possible reasons.')
ENDIF
DO WHILE (CountM <= NumAlphas)
IF (LEN_TRIM(cAlphaArgs(CountM)) == MaxNameLength) THEN
CALL ShowContinueError(TRIM(cAlphaArgs(CountM))//TRIM(cAlphaArgs(CountM+1)))
CountM=CountM+2
ELSE
CALL ShowContinueError(TRIM(cAlphaArgs(CountM)))
CountM=CountM+1
ENDIF
ENDDO
ENDDO
ENDIF
RETURN
END SUBROUTINE PreProcessorCheck