      SUBROUTINE UERTST (IER,NAME)
C   IMSL ROUTINE NAME   - UERTST
C 
C-----------------------------------------------------------------------
C 
C   COMPUTER            - CRAY/SINGLE 
C 
C   LATEST REVISION     - JUNE 1, 1982
C 
C   PURPOSE             - PRINT A MESSAGE REFLECTING AN ERROR CONDITION 
C 
C   USAGE               - CALL UERTST (IER,NAME)
C 
C   ARGUMENTS    IER    - ERROR PARAMETER. (INPUT)
C                           IER = I+J WHERE 
C                             I = 128 IMPLIES TERMINAL ERROR MESSAGE, 
C                             I =  64 IMPLIES WARNING WITH FIX MESSAGE, 
C                             I =  32 IMPLIES WARNING MESSAGE.
C                             J = ERROR CODE RELEVANT TO CALLING
C                                 ROUTINE.
C                NAME   - A CHARACTER STRING OF LENGTH SIX PROVIDING
C                           THE NAME OF THE CALLING ROUTINE. (INPUT)
C 
C   PRECISION/HARDWARE  - SINGLE/ALL
C 
C   REQD. IMSL ROUTINES - UGETIO,USPKD
C 
C   NOTATION            - INFORMATION ON SPECIAL NOTATION AND 
C                           CONVENTIONS IS AVAILABLE IN THE MANUAL
C                           INTRODUCTION OR THROUGH IMSL ROUTINE UHELP
C 
C   REMARKS      THE ERROR MESSAGE PRODUCED BY UERTST IS WRITTEN
C                TO THE STANDARD OUTPUT UNIT. THE OUTPUT UNIT 
C                NUMBER CAN BE DETERMINED BY CALLING UGETIO AS
C                FOLLOWS..   CALL UGETIO(1,NIN,NOUT). 
C                THE OUTPUT UNIT NUMBER CAN BE CHANGED BY CALLING 
C                UGETIO AS FOLLOWS..
C                                NIN = 0
C                                NOUT = NEW OUTPUT UNIT NUMBER
C                                CALL UGETIO(3,NIN,NOUT)
C                SEE THE UGETIO DOCUMENT FOR MORE DETAILS.
C 
C   WARRANTY            - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN 
C                           APPLIED TO THIS CODE. NO OTHER WARRANTY,
C                           EXPRESSED OR IMPLIED, IS APPLICABLE.
C 
C-----------------------------------------------------------------------
C 
C                                  SPECIFICATIONS FOR ARGUMENTS 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      INTEGER            IER
      INTEGER            NAME(1)
C                                  SPECIFICATIONS FOR LOCAL VARIABLES 
      INTEGER            I,IEQDF,IOUNIT,LEVEL,LEVOLD,NIN,NMTB 
      CHARACTER*1        NAMEQ(6),NAMSET(6),NAMUPK(6),IEQ
      DATA               NAMSET/'U','E','R','S','E','T'/
      DATA               NAMEQ/6*' '/ 
      DATA               LEVEL/4/,IEQDF/0/,IEQ/'='/ 
C                                  UNPACK NAME INTO NAMUPK
C                                  FIRST EXECUTABLE STATEMENT 
      CALL USPKD (NAME,6,NAMUPK,NMTB) 
C                                  GET OUTPUT UNIT NUMBER 
      CALL UGETIO(1,NIN,IOUNIT) 
C                                  CHECK IER
      IF (IER.GT.999) GO TO 25
      IF (IER.LT.-32) GO TO 55
      IF (IER.LE.128) GO TO 5 
      IF (LEVEL.LT.1) GO TO 30
C                                  PRINT TERMINAL MESSAGE 
      IF (IEQDF.EQ.1) WRITE(IOUNIT,35) IER,NAMEQ,IEQ,NAMUPK 
      IF (IEQDF.EQ.0) WRITE(IOUNIT,35) IER,NAMUPK 
      GO TO 30
    5 IF (IER.LE.64) GO TO 10 
      IF (LEVEL.LT.2) GO TO 30
C                                  PRINT WARNING WITH FIX MESSAGE 
      IF (IEQDF.EQ.1) WRITE(IOUNIT,40) IER,NAMEQ,IEQ,NAMUPK 
      IF (IEQDF.EQ.0) WRITE(IOUNIT,40) IER,NAMUPK 
      GO TO 30
   10 IF (IER.LE.32) GO TO 15 
C                                  PRINT WARNING MESSAGE
      IF (LEVEL.LT.3) GO TO 30
      IF (IEQDF.EQ.1) WRITE(IOUNIT,45) IER,NAMEQ,IEQ,NAMUPK 
      IF (IEQDF.EQ.0) WRITE(IOUNIT,45) IER,NAMUPK 
      GO TO 30
   15 CONTINUE
C                                  CHECK FOR UERSET CALL
      DO 20 I=1,6 
         IF (NAMUPK(I).NE.NAMSET(I)) GO TO 25 
   20 CONTINUE
      LEVOLD = LEVEL
      LEVEL = IER 
      IER = LEVOLD
      IF (LEVEL.LT.0) LEVEL = 4 
      IF (LEVEL.GT.4) LEVEL = 4 
      GO TO 30
   25 CONTINUE
      IF (LEVEL.LT.4) GO TO 30
C                                  PRINT NON-DEFINED MESSAGE
      IF (IEQDF.EQ.1) WRITE(IOUNIT,50) IER,NAMEQ,IEQ,NAMUPK 
      IF (IEQDF.EQ.0) WRITE(IOUNIT,50) IER,NAMUPK 
   30 IEQDF = 0 
      RETURN
   35 FORMAT(' *** TERMINAL ERROR,10X,"(IER = "',I3, 
     1       ') FROM IMSL ROUTINE ',6A1,A1,6A1)
   40 FORMAT(' *** WARNING WITH FIX ERROR',2X,'(IER = ',I3,
     1       ') FROM IMSL ROUTINE ',6A1,A1,6A1)
   45 FORMAT(' *** WARNING ERROR',11X,'(IER = ',I3,
     1       ') FROM IMSL ROUTINE ',6A1,A1,6A1)
   50 FORMAT(' *** UNDEFINED ERROR',9X,'(IER = ',I5, 
     1       ') FROM IMSL ROUTINE ',6A1,A1,6A1)
C 
C                                  SAVE P FOR P = R CASE
C                                    P IS THE PAGE NAMUPK 
C                                    R IS THE ROUTINE NAMUPK
   55 IEQDF = 1 
      DO 60 I=1,6 
   60 NAMEQ(I) = NAMUPK(I)
   65 RETURN
      END 
