cunpack - convert packed character format file to random binary
c
c  This routine converts Kermit-GCOS from the packed character
c  format used on the Columbia distribution tape to an executable
c  Honeywell H* file.
c
c  The packed format is:
c    Columns   Contents
c      1- 6      Zero origin word address of first word on line
c      7-12      First data word as 6 characters
c     13-18      Second data word
c      ...        ...
c     61-66      Tenth data word
c        67      Checksum for this data line
c        68      "|"
c
c  Data words are packed into six ASCII characters each, using only
c  printable ASCII characters in the range 32 through 96, excluding
c  64.
c  These are formed by
c  adding 32 to each 6-bit field from a 36-bit word, plus one if the
c  six-bit value is 32 or greater.
c  Thus, each 10 words generate a 15 word ASCII
c  data record.  Data records consisting of only words which are all
c  zero are discarded.
c
c  The checksum is the rightmost six bits of the integer value
c  obtained by adding each of the 60 6-bit field used to generate
c  the data string, plus 32 to make it a printing ASCII character,
c  plus one if the original value is 32 or greater.
c
c  The final "|" is added to make the record length a multiple of
c  four so record boundaries fall on word boundaries without padding,
c  and to give a simple visual verification of the correct end of
c  line.
c
c     hstar  - file code for random binary output file
      integer hstar/01/
c     infile - file code for packed text input file
      integer infile/02/
c     otbuff - buffer for binary output block
      integer otbuff(320)
c     text file input records are composed of:
c     inword - integer offset of first data word on line
      integer inword
c     inbuff - 15 words of ASCII text - binary in packed format.
      integer inbuff(15)
c     chksum - checksum computed when text record was formed.
      integer chksum
c     inrec - count of input text records
      integer inrec
c     otrec - count of binary output blocks
      integer otrec
c
      write(6,6010)
 6010 format(' Begin packed character to random binary conversion.')
c     define record length of random binary output file
      call ransiz(hstar,320,1)
      inrec = 0
      otrec = 1
c     clear output buffer
      do 5 ix=1,320
         otbuff(320) = 0
    5 continue
c
c  process each input record until end of text file.
   10 read(infile,1010,end=100) inword,inbuff,chksum
 1010    format(i6,15a4,a1)
         inrec = inrec+1
   12    if (inword .lt. 320*otrec) goto 20
            write(hstar'otrec) otbuff
            otrec = otrec + 1
            do 15 ix=1,320
               otbuff(ix) = 0
   15       continue
         goto 12
   20    call unpak2(inword,inbuff,chksum,otbuff(mod(inword,320)+1))
      goto 10
c
c     flush final output buffer
  100 write(hstar'otrec) otbuff
      write(6,6090) inrec,otrec
 6090 format(' Records read  =',i4/
     &       ' Blocks written=',i4/
      &      ' Conversion completed')
      stop
      end
      subroutine unpak2(inword,inbuff,chksum,otbuff)
c
c  Convert 10 words in packed text format to binary data.
c  Validate the checksum, and report any errors.
c
      integer inword
      integer inbuff(15)
      integer otbuff(10)
      integer chksum
c
c     ASF to put 6-bits into binary output data word
      raw(ix) = fld(6*mod(ix-1,6),6,otbuff((ix+5)/6))
c     ASF to get 6-bit value out of 9-bit field on text record
      packed(ix) = fld(9*mod(ix-1,4),9,inbuff((ix+3)/4)) - 32
c
      integer ix
c     newsum - local computation of checksum from packed text
      integer newsum
c
      newsum = 0
      do 10 ix=1,60
         ichar = packed(ix)
         newsum = newsum + ichar
         if (ichar .ge. 32) ichar = ichar - 1
         raw(ix) = ichar
   10 continue
      newsum = fld(30,6,newsum)
      if (newsum .ge. 32) newsum = newsum+1
      newsum = newsum + 32
      chksum = fld(0,9,chksum)
      if (newsum .ne. chksum) write(6,6010) inword,newsum,chksum
 6010 format(' Checksum error at word',i6/
     &       ' Computed: ',o12,'   Actual: ',o12)
      return
      end