C----------------------------------------------------------------------
        subroutine ftphpr(ounit,simple,bitpix,naxis,naxes,
     &                    pcount,gcount,extend,status)

C       write required primary header keywords
C
C       ounit   i  fortran output unit number
C       simple  l  does file conform to FITS standard?
C       bitpix  i  number of bits per data value
C       naxis   i  number of axes in the data array
C       naxes   i  array giving the length of each data axis
C       pcount  i  number of group parameters
C       gcount  i  number of random groups
C       extend  l  may extensions be present in the FITS file?
C       OUTPUT PARAMETERS:
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,i,ibuff
        character comm*50
        logical simple,extend

C       COMMON BLOCK DEFINITIONS:--------------------------------------------
        integer nb,ne
        parameter (nb = 12)
        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
C       END OF COMMON BLOCK DEFINITIONS-----------------------------------

        if (status .gt. 0)return

        ibuff=bufnum(ounit)

        if (chdu(ibuff) .eq. 1)then
            if (simple)then
                comm='file does conform to FITS standard'
            else
                comm='file does not conform to FITS standard'
            end if
            call ftpkyl(ounit,'SIMPLE',simple,comm,status)
        else  
            comm='IMAGE extension'
            call ftpkys(ounit,'XTENSION','IMAGE',comm,status)
        end if

C       test for legal value of bitpix
        call fttbit(bitpix,status)
        comm='number of bits per data pixel'
        call ftpkyj(ounit,'BITPIX',bitpix,comm,status)
        if (status .gt. 0)go to 900

        if (naxis .ge. 0 .and. naxis .le. 999)then
                comm='number of data axes'
                call ftpkyj(ounit,'NAXIS',naxis,comm,status)
        else
C               illegal value of naxis
                status=212
                go to 900
        end if

        comm='length of data axis'
        do 10 i=1,naxis
                if (naxes(i) .ge. 0)then
                        write(comm(21:23),1000)i
1000                    format(i3)      
                        call ftpknj(ounit,'NAXIS',i,1,naxes(i),comm,
     &                              status)
                else
C                       illegal NAXISnnn keyword value
                        status=213
                        go to 900
                end if
10      continue

        if (chdu(ibuff) .eq. 1)then
C               only write the EXTEND keyword to primary header if true
                if (extend)then
                        comm='FITS dataset may contain extensions'
                        call ftpkyl(ounit,'EXTEND',extend,comm,status)
                end if

C               write the PCOUNT and GCOUNT values if nonstandard
                if (pcount .gt. 0 .or. gcount .gt. 1)then
                    comm='random group records are present'
                    call ftpkyl(ounit,'GROUPS',.true.,comm,status)
                    comm='number of random group parameters'
                    call ftpkyj(ounit,'PCOUNT',pcount,comm,status)  
                    comm='number of random groups'
                    call ftpkyj(ounit,'GCOUNT',gcount,comm,status)
                end if
        else 
                comm='number of random group parameters'
                call ftpkyj(ounit,'PCOUNT',pcount,comm,status)                
                comm='number of random groups'
                call ftpkyj(ounit,'GCOUNT',gcount,comm,status) 
        end if

900     continue
        end
