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