C--------------------------------------------------------------------------
        subroutine ftpdef(ounit,bitpix,naxis,naxes,pcount,gcount,
     &                    status)

C       Primary data DEFinition
C       define the structure of the primary data unit or an IMAGE extension
C
C       ounit   i  Fortran I/O unit number
C       bitpix  i  bits per pixel value
C       naxis   i  number of data axes
C       naxes   i  length of each data axis (array)
C       pcount  i  number of group parameters
C       gcount  i  number of 'random groups'
C       status  i  output error status (0 = ok)
C
C       written by Wm Pence, HEASARC/GSFC, June 1991

        integer ounit,bitpix,naxis,naxes(*),pcount,gcount,status

C       COMMON BLOCK DEFINITIONS:--------------------------------------------
        integer nb,ne,nf
        parameter (nb = 12)
        parameter (ne = 128)
        parameter (nf = 512)
        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 ibuff,ttype,bytlen,npix,i,pcnt,gcnt

        if (status .gt. 0)return

        ibuff=bufnum(ounit)

        if (dtstrt(ibuff) .lt. 0)then
C               freeze the header at its current size
                call fthdef(ounit,0,status)
                if (status .gt. 0)return
        end if

C       check for error conditions
        if (naxis .lt. 0)then
                status=212
        else if (pcount .lt. 0)then
                status=214
        else if (gcount .lt. 0)then
                status=215
        else
                go to 5
        end if
        return

C       test that bitpix has a legal value and set the datatype code value
5       if (bitpix .eq. 8)then
                ttype=11
                bytlen=1
        else if (bitpix .eq. 16)then
                ttype=21
                bytlen=2
        else if (bitpix .eq. 32)then
                ttype=41
                bytlen=4
        else if (bitpix .eq. -32)then
                ttype=42
                bytlen=4
        else if (bitpix .eq. -64)then
                ttype=82
                bytlen=8
        else
C               illegal value of bitpix
                status=211
                return
        end if

C       calculate the number of pixels in the array
        if (naxis .eq. 0)then
C               no data
                npix=0
                gcnt=0
                pcnt=0
        else
C               make sure that the gcount is not zero
                gcnt=max(gcount,1)
                pcnt=pcount        
                npix=1
                do 10 i=1,naxis
                        if (naxes(i) .ge. 0)then
C       The convension used by 'random groups' with NAXIS1 = 0 is not
C       directly supported here.  If one want to write a 'random group'
C       FITS file, then one should call FTPDEF with naxes(1) = 1, but
C       then write the required header keywords (with FTPHPR) with 
C       naxes(1) = 0.
                                npix=npix*naxes(i)
                        else if (naxes(i) .lt. 0)then
                                status=213
                                return
                        end if
10              continue
        end if
C       the next HDU begins in the next logical block after the data
        hdstrt(ibuff,chdu(ibuff)+1)=
     &          dtstrt(ibuff)+((pcnt+npix)*bytlen*gcnt+2879)/2880*2880

C       the primary array is actually interpreted as a binary table.  There
C       are two columns: the first column contains the 
C       group parameters, if any, and the second column contains the
C       primary array of data.  Each group is a separate row in the table.
C       The scaling and null values are set to the default values.

        tfield(ibuff)=2
        rowlen(ibuff)=(pcnt+npix)*bytlen
        tdtype(1,ibuff)=ttype
        tdtype(2,ibuff)=ttype
        trept(1,ibuff)=pcnt
        trept(2,ibuff)=npix
C       choose a speical value to represent the absence of a blank value
        tnull(1,ibuff)=123454321
        tnull(2,ibuff)=123454321
        tscale(1,ibuff)=1.
        tscale(2,ibuff)=1.
        tzero(1,ibuff)=0.
        tzero(2,ibuff)=0.
        tbcol(1,ibuff)=0
        tbcol(2,ibuff)=pcnt*bytlen
        end
