FTN77,E,J,Y                                                                     
C   IMSL ROUTINE NAME   - UERTST                                                
C                                                                               
C-----------------------------------------------------------------------        
C                                                                               
C   COMPUTER            - HP1000/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   COPYRIGHT           - 1982 BY IMSL, INC. ALL RIGHTS RESERVED.               
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                                                                               
      SUBROUTINE UERTST (IER,NAME)                                              
C                                  SPECIFICATIONS FOR ARGUMENTS                 
      INTEGER            IER                                                    
      CHARACTER          NAME*(*)                                               
C                                  SPECIFICATIONS FOR LOCAL VARIABLES           
      INTEGER            I,IEQ,IEQDF,IOUNIT,LEVEL,LEVOLD,NAMEQ(6),              
     *                   NAMSET(6),NAMUPK(6),NIN,NMTB                           
      DATA               NAMSET/1HU,1HE,1HR,1HS,1HE,1HT/                        
      DATA               NAMEQ/6*1H /                                           
      DATA               LEVEL/4/,IEQDF/0/,IEQ/1H=/                             
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(19H *** TERMINAL ERROR,10X,7H(IER = ,I3,                           
     1       20H) FROM IMSL ROUTINE ,6A1,A1,6A1)                                
   40 FORMAT(27H *** WARNING WITH FIX ERROR,2X,7H(IER = ,I3,                    
     1       20H) FROM IMSL ROUTINE ,6A1,A1,6A1)                                
   45 FORMAT(18H *** WARNING ERROR,11X,7H(IER = ,I3,                            
     1       20H) FROM IMSL ROUTINE ,6A1,A1,6A1)                                
   50 FORMAT(20H *** UNDEFINED ERROR,9X,7H(IER = ,I5,                           
     1       20H) 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