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 | ||
---|---|---|---|---|---|---|
character(len=*) | :: | ErrorMessage | ||||
integer, | optional | :: | OutUnit1 | |||
integer, | optional | :: | OutUnit2 |
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 ShowErrorMessage(ErrorMessage,OutUnit1,OutUnit2)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN December 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine displays the error messages on the indicated
! file unit numbers, in addition to the "standard error output"
! unit.
! METHODOLOGY EMPLOYED:
! If arguments OutUnit1 and/or OutUnit2 are present the
! error message is written to these as well and the standard one.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataStringGlobals, ONLY: VerString,IDDVerString
USE DataInterfaces, ONLY: ShowFatalError
USE DataGlobals, ONLY: DoingInputProcessing,CacheIPErrorFile
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*) ErrorMessage
INTEGER, OPTIONAL :: OutUnit1
INTEGER, OPTIONAL :: OutUnit2
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: ErrorFormat='(2X,A)'
CHARACTER(len=*), PARAMETER :: fmtA='(A)'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER,SAVE :: TotalErrors=0 ! used to determine when to open standard error output file.
INTEGER,SAVE :: StandardErrorOutput
INTEGER,EXTERNAL :: GetNewUnitNumber
INTEGER :: write_stat
LOGICAL, SAVE :: ErrFileOpened=.false.
IF (TotalErrors .eq. 0 .and. .not. ErrFileOpened) THEN
StandardErrorOutput=GetNewUnitNumber()
OPEN(StandardErrorOutput,FILE='eplusout.err', Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL DisplayString('Trying to display error: "'//trim(ErrorMessage)//'"')
CALL ShowFatalError('ShowErrorMessage: Could not open file "eplusout.err" for output (write).')
ENDIF
WRITE(StandardErrorOutput,'(A)') 'Program Version,'//TRIM(VerString)//','//TRIM(IDDVerString)
ErrFileOpened=.true.
ENDIF
IF (.not. DoingInputProcessing) THEN
TotalErrors=TotalErrors+1
WRITE(StandardErrorOutput,ErrorFormat) TRIM(ErrorMessage)
ELSE
WRITE(CacheIPErrorFile,fmtA) TRIM(ErrorMessage)
ENDIF
IF (PRESENT(OutUnit1)) THEN
WRITE(OutUnit1,ErrorFormat) TRIM(ErrorMessage)
ENDIF
IF (PRESENT(OutUnit2)) THEN
WRITE(OutUnit2,ErrorFormat) TRIM(ErrorMessage)
ENDIF
RETURN
END SUBROUTINE ShowErrorMessage