C
C Subroutines to handle error and warning messages
C
C Version: 5.40
C Date: 2000, February 7
C
C Coded by: Ludek Klimes
C Department of Geophysics, Charles University Prague,
C Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C E-mail: klimes@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
C Output error file:
C
C The output error file has fixed name 'error.out'. It is assumed to be
C deleted before running the job, e.g., using Perl script 'go.pl'.
C When an error or warning message is issued, the message is appended to
C the error file, starting with string '##Error' or '##Warning',
C respectively. Error file 'error.out' should be checked for string
C '##Error' before running the next program of the job.
C
C.......................................................................
C
C This file consists of:
C ERROR...Subroutine to handle the error conditions indicated within
C the Fortran code. It writes a brief error message and
C STOPs the program. A user is encouraged to modify this
C routine to redirect the error message or to STOP the
C program in a different way.
C ERROR
C WARN... Subroutine to handle the warning messages indicated within
C the Fortran code. It writes a brief error message and
C PAUSEs the program. A user is encouraged to modify this
C routine to redirect the warning message or to change the
C PAUSE statement.
C WARN
C LUWARN..Integer external function to remember the logical unit
C number of the output file to write the warning messages.
C LUWARN
C
C=======================================================================
C
C
C
SUBROUTINE ERROR(TEXT)
CHARACTER*(*) TEXT
C
C Subroutine to handle the error conditions indicated within the Fortran
C code. It writes a brief error message and STOPs the program.
C A user is encouraged to modify this routine to redirect the error
C message or to STOP the program in a different way.
C
C Input:
C TEXT... A brief text identifying the error.
C Example: 'PRG-04: Too small array AAA', where PRG-04
C identifies the corresponding error in program PRG.
C Subroutine ERROR prepends string '##Error ' to TEXT
C when writing to a file, and string ' Error ' when
C writing to the standard output device *.
C No output.
C
C Date: 1999, May 24
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
EXTERNAL LUWARN
INTEGER LUWARN,LUERR
PARAMETER (LUERR=88)
C
C.......................................................................
C
C The error message is appended to error file 'error.out':
OPEN(LUERR,FILE='error.out')
10 CONTINUE
READ(LUERR,'(A)',END=11)
GO TO 10
11 CONTINUE
WRITE(LUERR,'(2A)') '##Error ',TEXT
CLOSE(LUERR)
C
C If a formatted output log file is open, a copy of the error
C message is written there:
IF (LUWARN(0).GT.0) THEN
WRITE(LUWARN(0),'(2A)') '##Error ',TEXT
END IF
C
C The error message is written to the standard output:
WRITE(*,'(2A)') ' Error ',TEXT
C
C PAUSE command may enable to terminate batch files or scripts on
C some systems:
* PAUSE
C
C Finally, the program must be STOPped:
STOP
END
C
C=======================================================================
C
C
C
SUBROUTINE WARN(TEXT)
CHARACTER*(*) TEXT
C
C Subroutine to handle the error conditions indicated within the Fortran
C code. It writes a brief error message and STOPs the program.
C A user is encouraged to modify this routine to redirect the error
C message or to STOP the program in a different way.
C Subroutine to handle the warning messages indicated within the Fortran
C code. It writes a brief error message and PAUSEs the program.
C A user is encouraged to modify this routine to redirect the warning
C message or to change the PAUSE statement.
C
C Input:
C TEXT... A brief text identifying the warning.
C Example: 'PRG-05: No header section found', where PRG-05
C identifies the corresponding warning in program PRG.
C Subroutine WARN prepends string '##Warning ' to TEXT
C when writing to a file, and string ' Warning ' when
C writing to the standard output device *.
C No output.
C
C Date: 1999, May 27
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
EXTERNAL LUWARN
INTEGER LUWARN,LUERR
PARAMETER (LUERR=88)
C
C The warning message is appended to error file 'error.out':
OPEN(LUERR,FILE='error.out')
10 CONTINUE
READ(LUERR,'(A)',END=11)
GO TO 10
11 CONTINUE
WRITE(LUERR,'(2A)') '##Warning ',TEXT
CLOSE(LUERR)
C
C If a formatted output log file is open, a copy of the warning
C message is written there:
IF (LUWARN(0).GT.0) THEN
WRITE(LUWARN(0),'(2A)') '##Warning ',TEXT
END IF
C
C The warning message is written to the standard output:
WRITE(*,'(2A)') '+Warning ',TEXT
WRITE(*,'(2A)')
C
C PAUSE command to suspend the execution:
* PAUSE
C
RETURN
END
C
C=======================================================================
C
C
C
INTEGER FUNCTION LUWARN(LU)
INTEGER LU
C
C Function to remember the logical unit number of the output file to
C write the warning, error and other messages to output log file,
C if it is defined.
C
C Input:
C LU... LU positive:
C LUWARN is redefined to LU. LU should represent the
C logical unit number of the formatted output log file to
C write the messages. Function LUWARN with such a value
C of LU should be called after opening the output log file
C which is usually performed from the main program.
C Otherwise:
C LUWARN is the last redefined value. LUWARN=0 when
C starting the program.
C Output:
C LUWARN..Logical unit number of the output log file to write the
C warning messages.
C LUWARN positive: formatted output log file is ready,
C LUWARN=0: output log file is not available.
C
C Example:
C First invocation:
C OPEN(LULOG,FILE=FLOG)
C LULOG=LUWARN(LULOG)
C Next invocations:
C IF (LUWARN(0).GT.0) THEN
C WRITE(LUWARN(0),'(2A)') ' Error ',TEXT
C END IF
C
C Note:
C For consistency, it is recommended that an error message starts
C with string '##Error ' at the begining of the first written line
C immediately followed by the string identifying the error, and
C a warning message starts with string '##Warning'. The strings
C enable to detect the error and to terminate execution of the
C corresponding script or history file.
C Numbered warnings should be listed in the list of errors.
C
C Date: 1997, November 22
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
INTEGER LUSTOR
SAVE LUSTOR
DATA LUSTOR/0/
C
IF(LU.GT.0) THEN
LUSTOR=LU
END IF
LUWARN=LUSTOR
RETURN
END
C
C=======================================================================
C