00001 00002 *DECK XERRWD 00003 SUBROUTINE XERRWD (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2) 00004 C***BEGIN PROLOGUE XERRWD 00005 C***SUBSIDIARY 00006 C***PURPOSE Write error message with values. 00007 C***LIBRARY MATHLIB 00008 C***CATEGORY R3C 00009 C***TYPE DOUBLE PRECISION (XERRWV-S, XERRWD-D) 00010 C***AUTHOR Hindmarsh, Alan C., (LLNL) 00011 C***DESCRIPTION 00012 C 00013 C Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV, 00014 C as given here, constitute a simplified version of the SLATEC error 00015 C handling package. 00016 C 00017 C All arguments are input arguments. 00018 C 00019 C MSG = The message (character array). 00020 C NMES = The length of MSG (number of characters). 00021 C NERR = The error number (not used). 00022 C LEVEL = The error level.. 00023 C 0 or 1 means recoverable (control returns to caller). 00024 C 2 means fatal (run is aborted--see note below). 00025 C NI = Number of integers (0, 1, or 2) to be printed with message. 00026 C I1,I2 = Integers to be printed, depending on NI. 00027 C NR = Number of reals (0, 1, or 2) to be printed with message. 00028 C R1,R2 = Reals to be printed, depending on NR. 00029 C 00030 C Note.. this routine is machine-dependent and specialized for use 00031 C in limited context, in the following ways.. 00032 C 1. The argument MSG is assumed to be of type CHARACTER, and 00033 C the message is printed with a format of (1X,A). 00034 C 2. The message is assumed to take only one line. 00035 C Multi-line messages are generated by repeated calls. 00036 C 3. If LEVEL = 2, control passes to the statement STOP 00037 C to abort the run. This statement may be machine-dependent. 00038 C 4. R1 and R2 are assumed to be in double precision and are printed 00039 C in D21.13 format. 00040 C 00041 C***ROUTINES CALLED IXSAV 00042 C***REVISION HISTORY (YYMMDD) 00043 C 920831 DATE WRITTEN 00044 C 921118 Replaced MFLGSV/LUNSAV by IXSAV. (ACH) 00045 C 930329 Modified prologue to SLATEC format. (FNF) 00046 C 930407 Changed MSG from CHARACTER*1 array to variable. (FNF) 00047 C 930922 Minor cosmetic change. (FNF) 00048 C***END PROLOGUE XERRWD 00049 C 00050 C*Internal Notes: 00051 C 00052 C For a different default logical unit number, IXSAV (or a subsidiary 00053 C routine that it calls) will need to be modified. 00054 C For a different run-abort command, change the statement following 00055 C statement 100 at the end. 00056 C----------------------------------------------------------------------- 00057 C Subroutines called by XERRWD.. None 00058 C Function routine called by XERRWD.. IXSAV 00059 C----------------------------------------------------------------------- 00060 C**End 00061 C 00062 C Declare arguments. 00063 C 00064 DOUBLE PRECISION R1, R2 00065 INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR 00066 CHARACTER*(*) MSG 00067 C 00068 C Declare local variables. 00069 C 00070 INTEGER LUNIT, IXSAV, MESFLG 00071 C 00072 C Get logical unit number and message print flag. 00073 C 00074 C***FIRST EXECUTABLE STATEMENT XERRWD 00075 LUNIT = IXSAV (1, 0, .FALSE.) 00076 MESFLG = IXSAV (2, 0, .FALSE.) 00077 IF (MESFLG .EQ. 0) GO TO 100 00078 C 00079 C Write the message. 00080 C 00081 WRITE (LUNIT,10) MSG(1:NMES) 00082 10 FORMAT(1X,A) 00083 IF (NI .EQ. 1) WRITE (LUNIT, 20) I1 00084 20 FORMAT(6X,'In above message, I1 =',I10) 00085 IF (NI .EQ. 2) WRITE (LUNIT, 30) I1,I2 00086 30 FORMAT(6X,'In above message, I1 =',I10,3X,'I2 =',I10) 00087 IF (NR .EQ. 1) WRITE (LUNIT, 40) R1 00088 40 FORMAT(6X,'In above message, R1 =',D21.13) 00089 IF (NR .EQ. 2) WRITE (LUNIT, 50) R1,R2 00090 50 FORMAT(6X,'In above, R1 =',D21.13,3X,'R2 =',D21.13) 00091 C 00092 C Abort the run if LEVEL = 2. 00093 C 00094 100 IF (LEVEL .NE. 2) RETURN 00095 CALL XSTOPX (' ') 00096 C----------------------- End of Subroutine XERRWD ---------------------- 00097 END
1.7.1
