CDECK  ID>, YBCDEX.
      SUBROUTINE YBCDEX

C--        UNPACK BINARY PAM FILE AND PRODUCE CARD IMAGES

      COMMON /QBCD/  IQNUM2(11),IQLETT(26),IQNUM(10),IQPLUS
     +,              IQMINS,IQSTAR,IQSLAS,IQOPEN,IQCLOS,IQDOLL,IQEQU
     +,              IQBLAN,IQCOMA,IQDOT,IQAPO,  IQCROS
      PARAMETER      (IQBITW=32, IQBITC=8, IQCHAW=4)
      COMMON /QMACH/ NQBITW,NQCHAW,NQLNOR,NQLMAX,NQLPTH,NQRMAX,QLPCT
     +,              NQOCT(3),NQHEX(3),NQOCTD(3)
      COMMON /QUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE
     +,              IQDLUN,IQFLUN,IQHLUN,IQCLUN,  NQUSED
      COMMON /CCHCH/ IFORPL,NOTHCC,MORGCC(6),MREPCC(6)
      COMMON /DPLINE/LTK,NWTK, KIMAPR(3), KIMA(20), KIMAPS(9)
      COMMON /IOFCOM/IOTALL,IOTOFF,IOTON,IOSPEC,IOPARF(5),IOMODE(12)
      COMMON /LUNSLN/NSTRM,NBUFCI,LUNVL(3),LUNVN(9),NOPTVL(4),NCHCH(6)
      PARAMETER      (IQBDRO=25, IQBMAR=26, IQBCRI=27, IQBSYS=31)
      COMMON /QBITS/ IQDROP,IQMARK,IQCRIT,IQZIM,IQZIP,IQSYS
                         DIMENSION    IQUEST(30)
                         DIMENSION                 LQ(99), IQ(99), Q(99)
                         EQUIVALENCE (QUEST,IQUEST),    (LQUSER,LQ,IQ,Q)
      COMMON //      QUEST(30),LQUSER(7),LQMAIN,LQSYS(24),LQPRIV(7)
     +,              LQ1,LQ2,LQ3,LQ4,LQ5,LQ6,LQ7,LQSV,LQAN,LQDW,LQUP
     +, KADRV(14),LADRV(11),LCCIX,LBUF,LLAST
     +, NVOPER(6),MOPTIO(31),JANSW,JCARD,NDECKR,NVUSEX(20)
     +, NVINC(6),NVUTY(17),IDEOF(9),NVPROX(6),LOGLVG,LOGLEV,NVWARX(6)
     +, NVOLDQ(4),MVOLD1,MVOLDN,  NVOLD(7),NRTOLD,NROLD,MAXEOF
     +, IDOLDV(8),JPDOLD,JOLD, NVARRI(9),LARX,LARXE,LINBIN, NVCCP(10)
     +, NVNEW(7),NRTNEW,NRNEW,LLASTN, IDNEWV(8),JPDNEW,NDKNEW
     +, NVNEWL(3),NCDECK,JNEW,MODEPR,  MWK(80),MWKX(80)
      DIMENSION      IDD(2),             IDP(2),             IDF(2)
      EQUIVALENCE
     +       (IDD(1),IDOLDV(1)), (IDP(1),IDOLDV(3)), (IDF(1),IDOLDV(5))
C--------------    END CDE                             -----------------  ------
      EQUIVALENCE (LUNEW,NVNEW(1))
      EQUIVALENCE (LSVARE,LADRV(9))
      CHARACTER    CHIMA*80
      EQUIVALENCE (CHIMA,KIMA)



      ICHCH = NOTHCC
      IF (IFORPL.NE.0)  ICHCH=7

      NPDH   = 0
      LPDH   = IQ(LSVARE-5)
      LUNPDH = IQ(LPDH)
      IF (MOPTIO(24).NE.0)   CALL AUXFIL (324,IQ(LPDH),4HPDH )
C-    1 ATT, 2 RES, 4 CARD, 8 DET, 16 EOF, 32 HOLD, 64 OUT, 256 I, 512 F

      IQ(LBUF+1) = 7
      IOTON = 256

C-----     START NEW PAM,  READ PAM HEADER RECORD

   21 JSV = IOTON
      CALL AUXFIL (0,NVOLD(1),4HPAM )
      CALL POPIN
      IF (NVARRI(1).EQ.4)    GO TO 29
      IDOLDV(5) = NVARRI(5)
      IDOLDV(6) = NVARRI(6)                                             -A8M

      IOTON = JSV
      CALL AUXFIL (68,NVNEW(1),5HCARDS)
      WRITE (IQPRNT,9022) IDF

      IF (MOPTIO(20).NE.0)   GO TO 24
      IF (NVNEW(7).EQ.0)     GO TO 31
      IF (IOMODE(5).NE.0)    GO TO 31
   24 WRITE (LUNEW,9024)
      NRNEW  = 1
      GO TO 31

C----              EOI

   29 CALL AUXFIL (512,NVOLD(1),0)
      CALL AUXFIL (512,NVNEW(1),0)
      IF (NPDH.EQ.0)         RETURN
      IQ(LPDH+8) = NPDH
      CALL AUXFIL (512,IQ(LPDH),0)
      RETURN


C-------           READ RECORD BY RECORD AND WRITE CARDS

   31 CALL POPIN
      LTK = LINBIN + NVARRI(9)
      NCT = NVARRI(8)
      LOOK= NVARRI(3)
      IF ((MOPTIO(14).NE.0) .AND. (NVARRI(1).EQ.3))   GO TO 49
      IF (NCT.EQ.0)          GO TO 49
      IF (ICHCH.EQ.0)        GO TO 41

C----      UNPACK CARD BY CARD, WITH CONTROL-CARD CHAR. CONVERSION

      DO 36  I=1,NCT
      J  = JARTPX (IQ(LTK))
      CALL KDCOPY (IQ(LTK))
      N  = LNBLNK (CHIMA(1:IQCHAW*NWTK))
      IF (N.NE.0)  THEN
          WRITE (LUNEW,1000) CHIMA(1:N)
        ELSE
          WRITE (LUNEW,1000)
        ENDIF
 1000 FORMAT (A)
   36 CONTINUE
      GO TO 47

C----      UNPACK CARD BY CARD, WITHOUT CONTROL-CARD CHAR. CONVERSION

   41 CONTINUE
      IF (MOPTIO(24).EQ.0)   GO TO 43
      IF (NVARRI(1) .EQ.0)   GO TO 43
      LTKSV = LTK
      CALL KDCOPY (IQ(LTK))
      CALL XOUTCF (LUNPDH,KIMA(1),NWTK)
      NPDH = NPDH + 1
      LTK  = LTKSV

   43 DO 46  I=1,NCT
      CALL KDCOPY (IQ(LTK))
      N  = LNBLNK (CHIMA(1:IQCHAW*NWTK))
      IF (N.NE.0)  THEN
          WRITE (LUNEW,1000) CHIMA(1:N)
        ELSE
          WRITE (LUNEW,1000)
        ENDIF
   46 CONTINUE

   47 NRNEW = NRNEW + NCT
      IF (LTK-LINBIN.NE.IQ(LINBIN)+1)   GO TO 51
   48 IF (LOOK.EQ.0)         GO TO 31
      IF (MOPTIO(19).EQ.0)   GO TO 49
      WRITE (LUNEW,9047)
      NRNEW = NRNEW + 1
   49 IF (LOOK.EQ.3)         GO TO 21
      GO TO 31

C--                YTOBIN PACKING INCONSISTENCY

   51 WRITE (IQPRNT,9051) NDECKR
      GO TO 48


C9022 FORMAT (1X/11H ---- FILE ,A8/1X)                                   A8M
 9022 FORMAT (1X/11H ---- FILE ,A6,A4/1X)                               -A8M
 9024 FORMAT (7H+TITLE.)
 9047 FORMAT (5H+EOD.)
 9051 FORMAT (1X,3(/1X,44(1H*)),'   YTOBIN PACKING INCONSISTENCY DETECTE
     FD IN DECK',I6/1X)
      END
