FTN4,L
      PROGRAM CNFGD 
C-------------------------------------------------------------------
C 
C      RELOC.       09580-16082 
C      SOURCE       09580-18082 
C 
C     G. HOSS       REV.A    770505 
C 
C      HP 92425A TEST SYSTEM SOFTWARE IS THE PROPRIETARY
C      MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND
C      DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT.
C 
C      (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.
C      ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM
C      MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED 
C      TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C      WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.
C 
C-------------------------------------------------------------------
C*********************************************************************
C*       CONFIGURATION TABLE DUMP 
C********** 
C********** 
C*
C*       THIS PROGRAM DOES A CONFIGURATION TABLE DUMP, PRINTING IT
C*       IN READABLE FORM.
C*
C*       TO USE - RUN,CNFGD,[STATION #,LU#,DEVICE TYPE] 
C 
C     ERRORS:    CNFGD-1  PARAMETER ERROR 
C                  "  -2  NON EXISTENT DEVICE TYPE
C 
C*
C*********************************************************************
      INTEGER DEVTYP,CLASS,UNITS,UNUM 
      INTEGER BLANK 
      DIMENSION IPRAM(5)
      DIMENSION IERMS(4)
      DIMENSION IBUF(130) 
      DATA IERMS/5,2HCN,2HFG,2HD /
      DATA IRD/60000B/
      DATA BLANK/2H  /
      CALL RMPAR(IPRAM) 
      KNT=2 
      IG = 1
      IO = 0
      IER = 0 
C*********************************************************************
C*       GET FIRST CLASS# 
C*       RETRIEVE FIRST RECORD
C*********************************************************************
      IERR = 1
      DO 11 JJ = 1,3
      IF(IPRAM(JJ).LT.0)GO TO 800 
11    CONTINUE
      ISTN= ISN(DUMMY)
      IOUT = ISTN 
      IF(IPRAM.NE.0)ISTN = IPRAM
      IF(IPRAM(2).NE.0)IOUT= IPRAM(2) 
      CALL RTCLN(ISTN,CLASS)
      IERR = 10 
      IF(CLASS.EQ.0)GO TO 800 
      IREAD=IOR(IRD,CLASS)
      WRITE( IOUT,1000)ISTN 
1000  FORMAT(2X," CONFIGURATION TABLE FOR STATION ",I4) 
      IO  = 1 
      CALL EXEC(21,IREAD,IBUF,130)
C*********************************************************************
C*       RETRIEIVE DEVICE TYPE AND USE TO RETRIEVE DEVICE NAME
C*       DEVICE NAME FROM FILE DEVNAM (DEVNAM MAXIMUM 60 CHAR)
C*       DEVICE TYPE IS NUMBER OF RECORD IN FILE WHERE NAME IS LOCATED
C*********************************************************************
 50   CALL COUNT(KNT,IBUF,IO,IERMS) 
      IF(IPRAM(3).EQ.0)GO TO 90 
      IG = 2
      GO TO(90,95),IG 
90    WRITE(IOUT,1) 
 1    FORMAT(2X)
95    DEVTYP=IBUF(KNT)
      IF(DEVTYP.EQ.IPRAM(3))IG = 1
      GO TO(100,110),IG 
100   WRITE( IOUT,2) DEVTYP 
 2    FORMAT(1X,"DEVICE TYPE",3X,I3)
C*********************************************************************
C*       RETRIEVE NUMBER OF UNITS 
C*********************************************************************
110   CALL COUNT(KNT,IBUF,IO,IERMS) 
      UNITS=IBUF(KNT) 
      GO TO (200,210),IG
200   WRITE(IOUT ,3) UNITS
 3    FORMAT(1X,"NUMBER OF UNITS",3X,I6)
C*********************************************************************
C*       RETRIEVE NUMBER OF SUBRECORDS
C*********************************************************************
210   CALL COUNT(KNT,IBUF,IO,IERMS) 
      SBREC=IBUF(KNT) 
      GO TO(300,310),IG 
300   WRITE(IOUT ,4) SBREC
 4    FORMAT(1X,"NUMBER OF SUBRECORDS",3X,I6) 
      WRITE( IOUT,1)
C*********************************************************************
C*       RETRIEVE UNIT NUMBER 
C*********************************************************************
310   DO 10 J=UNITS,1,-1
         CALL COUNT(KNT,IBUF,IO,IERMS)
         UNUM=IBUF(KNT) 
      GO TO (400,410),IG
400      WRITE( IOUT,5) UNUM
 5       FORMAT(1X,"UNIT NUMBER",3X,I6) 
         WRITE( IOUT,1) 
C*********************************************************************
C*       RETIEVE SUBRECORDS 
C*********************************************************************
410      DO 20 K=SBREC,1,-1 
            CALL COUNT(KNT,IBUF,IO,IERMS) 
            INFO=IBUF(KNT)
      GO TO (500,20 ),IG
500         WRITE( IOUT,6) INFO 
 6          FORMAT(10X,K6)
 20      CONTINUE 
      GO TO(600,10),IG
600      WRITE( IOUT,1) 
 10   CONTINUE
      GO TO(700,710),IG 
700   WRITE( IOUT,7)
 7    FORMAT(1X,"*******************************************")
710   GO TO 50
800   CALL ERROR(IERR,IERMS)
      CALL EXEC(6)
      END 
C*********************************************************************
C*       ***** SUBROUTINE COUNT ***** 
C*
C*       INCREMENTS KNT 
C*
C*       IF END OF RECORD(LAST ITEM=XX) RETRIEVES NEXT RECORD 
C*       AND RETURNS IT IN IBUF 
C*
C*       IF END OF FILE TERMINATES PROGRAM
C*********************************************************************
      SUBROUTINE COUNT(KNT,IBUF,IO ,IERMS)
      INTEGER CLASS 
      DIMENSION IBUF(130) 
      DATA IRD/60000B/
      KNT=KNT+1 
C*********************************************************************
C*       IF END OF RECORD GET NEW RECORD
C*********************************************************************
      IF(KNT.LE.IBUF(2))GO TO 99
         CLASS=IBUF(1)
         IREAD=IOR(IRD,CLASS) 
         CALL EXEC(21,IREAD,IBUF,130) 
         KNT=3
C*********************************************************************
C*       IF END OF FILE STOP
C*********************************************************************
 99   IF(IBUF(KNT).NE.054130B) RETURN 
      IF(IO .NE.0)GO TO 990 
      IERR = 2
      CALL ERROR(IERR,IERMS)
990   CALL EXEC(6)
      END 
      END$
                                                                                                                                            