FTN4
C                                                        <800822.0733>
C 
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C 
C           NAME:   EDTU0 
C           SOURCE: 92074-18004 
C           RELOC:  PART OF 92074-12001 
C           PGMR:   J.D.J.
C 
C 
C 
C SUBROUTINE TO EXTRACT A NAMR FROM AN OPEN DCB 
C CALL IS:
C     CALL ENAMR(DCB,ERROR,NAMR-BLOCK)
C NAMR-BLOCK IS THE USUAL TEN-WORD GUY
C 
      INTEGER FUNCTION ENAMR(DCB,ERROR,CMDVAL)
     C,92074-1X004 REV.2034 800818
      IMPLICIT INTEGER (A-Z)
      INTEGER DCB(144),CMDVAL(10) 
C 
C     CLEAR OUT THE LU, TYPE, SIZE, REC LEN AND EXTRA  WORDS
C 
      DO 10 I = 6,10
  10  CMDVAL(I) = 0 
C 
C     CLEAR OUT BIT FIELDS EXCEPT FOR NAME AND SC 
C 
      CMDVAL(4) = IAND(CMDVAL(4),17B) 
C 
C 
C     GET CARTRIDGE 
C 
      CALL LOCF(DCB,ERROR,IREC,IRB,IOFF,JSEC,JLU,JTY) 
      IF( ERROR .LT. 0 ) GOTO 7000
  
      CMDVAL(6) = CLUCR(JLU)
C 
C     GET TYPE
C 
      CMDVAL(7) = JTY 
C 
C     BUILD WORD FULL OF TYPE BITS
C 
      CMDVAL(4) = ISHFT(NAMRT(CMDVAL(7)),6) 
     *          + ISHFT(NAMRT(CMDVAL(6)),4) 
     *          + CMDVAL(4) 
C 
C     WE DID IT!
C 
      ERROR = 0 
7000  ENAMR = ERROR 
      RETURN
C 
C     HERE ON I/O ERROR 
C 
C* 6000 ERROR = -1
C*      RETURN
      END 
  
C 
C  TNAMR - TYPES NAMR  - CALLS NAMR AND BUILD A CORRECT TYPE FIELD
C 
  
      INTEGER FUNCTION TNAMR(NRBUF,BUF,LNG,CNT) 
     C,92074-1X004 REV.2034 800818
      INTEGER NRBUF(10), BUF(1), LNG, CNT 
  
C 
C  PARSE WITH NAMR
C 
      TNAMR = NAMR(NRBUF,BUF,LNG,CNT) 
C 
C  LEAVE FILE NAME TYPE ALONE 
C 
      NRBUF(4) = IAND(NRBUF(4),3B)
C 
C  BUILD TYPE FOR REMAINING PARAMS
C 
        NRBUF(4) = NRBUF(4) + ISHFT(NAMRT(NRBUF(5)),2)
     1                      + ISHFT(NAMRT(NRBUF(6)),4)
     2                      + ISHFT(NAMRT(NRBUF(7)),6)
     3                      + ISHFT(NAMRT(NRBUF(8)),8)
      END 
                                                                                                                                                                                                                                  