This routine creates a FITS binary table, or BINTABLE, containing 3 columns and 6 rows. This routine is nearly identical to the previous WRITEASCII routine, except that the call to FTGABC is not needed, and FTPHBN is called rather than FTPHTB to write the required header keywords.
subroutine writebintable C Create a binary table containing 3 columns and 6 rows integer status,unit,readwrite,blocksize,hdutype,tfields,nrows integer varidat,diameter(6), colnum,frow,felem real density(6) character filename*40,extname*16 character*16 ttype(3),tform(3),tunit(3),name(6) data ttype/'Name','Diameter','Density'/ data tform/'8A','1J','1E'/ data tunit/' ','km','g/cm'/ data name/'Mars','Jupiter','Saturn','Uranus','Neptune','Pluto'/ data diameter/6800,143000,121000,47000,45000,6000/ data density/3.94,1.33,0.69,1.56,2.27,1.0/ 1 status=0 C Name of the FITS file to append the ASCII table to: filename='ATESTFILEZ.FITS' C Get an unused Logical Unit Number to use to open the FITS file 2 call ftgiou(unit,status) C open the FITS file, with write access 3 readwrite=1 call ftopen(unit,filename,readwrite,blocksize,status) C move to the last (2nd) HDU in the file 4 call ftmahd(unit,2,hdutype,status) C append/create a new empty HDU onto the end of the file and move to it 5 call ftcrhd(unit,status) C define parameters for the binary table (see the above data statements) tfields=3 nrows=6 extname='PLANETS_BINARY' varidat=0 C write the required header parameters for the binary table 6 call ftphbn(unit,nrows,tfields,ttype,tform,tunit, & extname,varidat,status) C write names to the first column, diameters to 2nd col., and density to 3rd frow=1 felem=1 colnum=1 7 call ftpcls(unit,colnum,frow,felem,nrows,name,status) colnum=2 call ftpclj(unit,colnum,frow,felem,nrows,diameter,status) colnum=3 call ftpcle(unit,colnum,frow,felem,nrows,density,status) C close the FITS file and free the unit number 8 call ftclos(unit, status) call ftfiou(unit, status) C check for any error, and if so print out error messages 9 if (status .gt. 0)call printerror(status) end