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 http://sw3d.cz/staff/klimes.htm 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