FTN 
      SUBROUTINE DBER2(LU1,IERR,NAMR,MESS,ABORT)
     +,92069-16184 REV.2013 790927
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18184
C     RELOC:     92069-16184
C 
C 
C****************************************************************:
C 
C 
C*******************************************************
C DBER2 PRINTS OUT AN ERROR MESSAGE.
C 
C THE FORM OF THE ERROR MESSAGE IS AS FOLLOWS:
C 
C ERROR NUMBER XXXXX  FOR YYYYY ZZZZZZ
C WHERE XXXXX IS THE ERROR NUMBER 
C       YYYYY IS EITHER "LU" OR "FILE"
C       ZZZZZZ IS EITHER THE LU NUMBER OR THE FILE NAME.
C 
C IF NAMR IS "XXXXXX" UPON ENTRY, THE ERROR MESSAGE IS AS FOLLOWS:
C ERROR NUMBER XXXXX
C 
C THE NAMR PASSED IN IS ONE OF THE FOUR FOLLOWING TYPES:
C 1) 6HXXXXXX 
C 2) AN LU NUMBER FOR AN FMP ERROR
C 3) A FILE NAME FOR AN FMP ERROR OR A DATA BASE ERROR. 
C 4) A FILE OR ITEM NUMBER FOR A DATA BASE NUMBER.
C 
C AFTER THIS: 
C IF ABORT=AB, IT DOES A STOP 
C IF ABORT=XX, IT RETURNS.
C ELSE IT CALLS IN THE SEGMENT NAMED BY ABORT.
C 
C*******************************************************
      INTEGER LU1,IERR,MESS(1),ABORT
      INTEGER NAMR(1) 
      INTEGER NAMR1(3)
      INTEGER NOSEG(8 ),NOSGL 
      DOUBLE PRECISION NAMR3(1) 
      EQUIVALENCE (NAMR1,NAMR3) 
      DOUBLE PRECISION ERROR(6) 
      DATA ERROR/6HERROR ,6HNUMBER,6H000000,6H  FOR ,6H      ,6H      / 
      DATA NOSEG/2H S,2HEG,2HME,2HNT,2H M,2HIS,2HSI,2HNG/ 
      DATA NOSGL/8 /
C********************************************************** 
C 
      IF (IERR .EQ. 0) RETURN 
      IERR2=IABS(IERR)
C***************************************************************
C PUT THE THREE WORDS OF NAMR INTO NAMR3 (NAMR1 EQU NAMR3). 
C 
      NAMR1=NAMR
      NAMR1(2)=NAMR(2)
      NAMR1(3)=NAMR(3)
C*****************************************************************
C CONVERT THE ERROR NUMBER AND INSERT INTO MESSAGE. INSERT THE
C NAMR INTO THE MESSAGE.
C 
      CALL REIO(2,LU1,2H _,1) 
      CALL CNUMD(IERR2,ERROR(3))
      ERROR(5)=6H FILE
      ERROR(6)=NAMR3
C*************************************************************
C ON AN FMP ERROR WHERE THE NAMR PASSED IN IS AN LU NUMBER. 
C 
      IF(NAMR .GE. 64) GOTO 10
      CALL CNUMD(NAMR,ERROR(6)) 
      IF(IERR2 .LT. 100) ERROR(5) = 6H LU 
C***************************************************************
C SEE HOW MANY WORDS OF THE MESSAGE TO PRINT OUT. 
C 
10    CONTINUE
      LEN=18
      IF (NAMR3 .EQ. 6HXXXXXX) LEN=9
      CALL REIO(2,LU1,ERROR,LEN)
C*********************************************************
C SEE ABOUT ABORTING OR RETURNING.
C 
9000  IF (ABORT .EQ. 2HXX) RETURN 
      IF (ABORT .EQ. 2HAB) STOP 
      CALL SEGLD(ABORT,IERR)
      CALL REIO(2,LU1,NOSEG,NOSGL)
      CALL REIO(2,LU1,ABORT,3)
      STOP
      END 
                                                                                                                                            