Mercurial > octave-nkf
view libcruft/odessa/xerr.f @ 3983:7a37caf6ed43
[project @ 2002-07-11 02:36:25 by jwe]
author | jwe |
---|---|
date | Thu, 11 Jul 2002 02:37:44 +0000 |
parents | |
children |
line wrap: on
line source
SUBROUTINE XERR (MSG, NERR, IERT, NI, I1, I2, NR, R1, R2) INTEGER NERR, IERT, NI, I1, I2, NR, 1 LUN, LUNIT, MESFLG DOUBLE PRECISION R1, R2 CHARACTER*(*) MSG C------------------------------------------------------------------- C C ALL ARGUMENTS ARE INPUT ARGUMENTS. C C MSG = THE MESSAGE (CHARACTER VARIABLE) C NERR = THE ERROR NUMBER (NOT USED). C IERT = THE ERROR TYPE.. C 1 MEANS RECOVERABLE (CONTROL RETURNS TO CALLER). C 2 MEANS FATAL (RUN IS ABORTED--SEE NOTE BELOW). C NI = NUMBER OF INTEGERS (0, 1, OR 2) TO BE PRINTED WITH MESSAGE. C I1,I2 = INTEGERS TO BE PRINTED, DEPENDING ON NI. C NR = NUMBER OF REALS (0, 1, OR 2) TO BE PRINTED WITH MESSAGE. C R1,R2 = REALS TO BE PRINTED, DEPENDING ON NR. C C NOTES: C 1. THE DIMENSION OF MSG IS ASSUMED TO BE AT MOST 60. C (MULTI-LINE MESSAGES ARE GENERATED BY REPEATED CALLS.) C 2. IF IERT = 2, CONTROL PASSES TO THE STATEMENT STOP C TO ABORT THE RUN. THIS STATEMENT MAY BE MACHINE-DEPENDENT. C 3. R1 AND R2 ARE ASSUMED TO BE IN DOUBLE PRECISION AND ARE PRINTED C IN D21.13 FORMAT. C 4. THE COMMON BLOCK /EH0001/ BELOW IS DATA-LOADED (A MACHINE- C DEPENDENT FEATURE) WITH DEFAULT VALUES. C THIS BLOCK IS NEEDED FOR PROPER RETENTION OF PARAMETERS USED BY C THIS ROUTINE WHICH THE USER CAN RESET BY CALLING ODESSA_XSETF OR XSETUN. C THE VARIABLES IN THIS BLOCK ARE AS FOLLOWS.. C MESFLG = PRINT CONTROL FLAG.. C 1 MEANS PRINT ALL MESSAGES (THE DEFAULT). C 0 MEANS NO PRINTING. C LUNIT = LOGICAL UNIT NUMBER FOR MESSAGES. C THE DEFAULT IS 6 (MACHINE-DEPENDENT). C 5. TO CHANGE THE DEFAULT OUTPUT UNIT, CHANGE THE DATA STATEMENT C IN THE BLOCK DATA SUBPROGRAM BELOW. C C FOR A DIFFERENT RUN-ABORT COMMAND, CHANGE THE STATEMENT FOLLOWING C STATEMENT 100 AT THE END. C----------------------------------------------------------------------- COMMON /EH0001/ MESFLG, LUNIT IF (MESFLG .EQ. 0) GO TO 100 C GET LOGICAL UNIT NUMBER. --------------------------------------------- LUN = LUNIT C WRITE THE MESSAGE. --------------------------------------------------- WRITE (LUN, 10) MSG 10 FORMAT(1X,A) C----------------------------------------------------------------------- IF (NI .EQ. 1) WRITE (LUN, 20) I1 20 FORMAT(6X,'IN ABOVE MESSAGE, I1 = ',I10) IF (NI .EQ. 2) WRITE (LUN, 30) I1,I2 30 FORMAT(6X,'IN ABOVE MESSAGE, I1 = ',I10,3X,'I2 = ',I10) IF (NR .EQ. 1) WRITE (LUN, 40) R1 40 FORMAT(6X,'IN ABOVE MESSAGE, R1 = ',D21.13) IF (NR .EQ. 2) WRITE (LUN, 50) R1,R2 50 FORMAT(6X,'IN ABOVE, R1 = ',D21.13,3X,'R2 = ',D21.13) C ABORT THE RUN IF IERT = 2. ------------------------------------------- 100 IF (IERT .NE. 2) RETURN STOP C----------------------- END OF SUBROUTINE XERR ---------------------- END