C----------------------------------------------------------------------
        subroutine ftpclx(iunit,colnum,frow,fbit,nbit,lray,status)

C       write an array of logical values to a specified bit or byte
C       column of the binary table.   If the LRAY parameter is .true.,
C       then the corresponding bit is set to 1, otherwise it is set
C       to 0.
C       The binary table column being written to must have datatype 'B'
C       or 'X'. 

C       iunit   i  fortran unit number
C       colnum  i  number of the column to write to
C       frow    i  first row to write
C       fbit    i  first bit within the row to write
C       nbit    i  number of bits to write
C       lray    l  array of logical data values corresponding to the bits
C                        to be written
C       status  i  output error status
C
C       written by Wm Pence, HEASARC/GSFC, Mar 1992
C       modified by Wm Pence May 1992 to remove call to system dependent
C                                     bit testing and setting routines.

        integer iunit,colnum,frow,fbit,nbit,status
        logical lray(*)

C       COMMON BLOCK DEFINITIONS:--------------------------------------------
        integer nf,nb,ne
        parameter (nb = 12)
        parameter (nf = 512)
        parameter (ne = 128)
        integer bufnum,bufpnt,reclen,recnum,bytnum
        integer chdu,maxhdu,hdstrt,hdend,nxthdr,dtstrt
        logical wrmode,modify
        real compid
        common/ft0001/bufnum(199),bufpnt(nb),reclen(199),recnum(nb),
     &  bytnum(nb),wrmode(nb),modify(nb),chdu(nb),maxhdu(nb),
     &  hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),compid
        integer tfield,tbcol,rowlen,tdtype,trept,tnull,scount
        integer theap,nxheap
        double precision tscale,tzero
        common/ft0002/tfield(nb),tbcol(nf,nb),rowlen(nb),tdtype(nf,nb),
     &  trept(nf,nb),tscale(nf,nb),tzero(nf,nb),tnull(nf,nb),scount(nb)
     &  ,theap(nb),nxheap(nb)
C       END OF COMMON BLOCK DEFINITIONS-----------------------------------

        integer bstart,offset,tcode,fbyte,bitloc,ndone
        integer ibuff,i,ntodo,repeat,rstart,estart,buffer
        logical descrp,wrbit(8),setbit(8)
        
        if (status .gt. 0)return

        ibuff=bufnum(iunit)
        tcode=tdtype(colnum,ibuff)

C       check input parameters
        if (nbit .le. 0)then
                return
        else if (frow .lt. 1)then
C               error: illegal first row number
                status=307
                return
        else if (fbit .lt. 1)then
C               illegal element number
                status=308
                return
        end if

        fbyte=(fbit+7)/8
        bitloc=fbit-(fbit-1)/8*8
        ndone=0
        ntodo=nbit
        rstart=frow-1
        estart=fbyte-1

        if (tcode .eq. 11)then
                descrp=.false.
C               N.B: REPEAT is the number of bytes, not number of bits
                repeat=trept(colnum,ibuff)
                if (fbyte .gt. repeat)then
C                               illegal element number
                                status=308
                                return
                end if
C               calc the i/o pointer location to start of sequence of pixels
                bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+
     &          tbcol(colnum,ibuff)+estart
        else if (tcode .eq. -11)then
C               this is a variable length descriptor column
                descrp=.true.
C               only bit arrays (tform = 'X') are supported for variable
C               length arrays.  REPEAT is the number of BITS in the array.        
                repeat=estart+ntodo
                offset=nxheap(ibuff)
C               write the number of elements and the starting offset:
                call ftpdes(iunit,colnum,frow,repeat,
     &                              offset,status)
C               calc the i/o pointer location to start of sequence of pixels
                bstart=dtstrt(ibuff)+offset+
     &                          theap(ibuff)+estart
C               increment the empty heap starting address (in bytes):
                repeat=(repeat+7)/8
                nxheap(ibuff)=nxheap(ibuff)+repeat
        else
C               column must be byte or bit data type
                status=310
                return
        end if

C       move the i/o pointer to the start of the pixel sequence
        call ftmbyt(iunit,bstart,.true.,status)

C       read the next byte (we may only be modifying some of the bits)
20      buffer=0
        call ftgbyt(iunit,1,buffer,status)
C       move back, to be able to overwrite the byte
        call ftmbyt(iunit,bstart,.false.,status)

C       reset flags indicating which bits are to be set
        wrbit(1)=.false.
        wrbit(2)=.false.
        wrbit(3)=.false.
        wrbit(4)=.false.
        wrbit(5)=.false.
        wrbit(6)=.false.
        wrbit(7)=.false.
        wrbit(8)=.false.

C       flag the bits that are to be set 
        do 10 i=bitloc,8
                wrbit(i)=.true.
                ndone=ndone+1
                if(lray(ndone))then
                        setbit(i)=.true.
                else
                        setbit(i)=.false.
                end if
                if (ndone .eq. ntodo)go to 100
10      continue

C       set or reset the bits within the byte
        call ftpbit(setbit,wrbit,buffer)

C       write the new byte
        call ftpbyt(iunit,1,buffer,status)
        
C       not done, so get the next byte
        bstart=bstart+1
        if (.not. descrp)then
                estart=estart+1
                if (estart .eq. repeat)then
C                       move the i/o pointer to the next row of pixels
                        estart=0
                        rstart=rstart+1
                        bstart=dtstrt(ibuff)+rstart*rowlen(ibuff)+
     &                         tbcol(colnum,ibuff)+estart
                        call ftmbyt(iunit,bstart,.true.,status)
                end if
        end if
        bitloc=1
        go to 20

100     continue
C       set or reset the bits within the byte
        call ftpbit(setbit,wrbit,buffer)

C       write the new byte
        call ftpbyt(iunit,1,buffer,status)
        end
