        program wsimpl

C       A simple program to write a primary array and a binary table extension.
C       This is designed to illustrate the basic sequence of FITSIO calls
C       needed to write a new FITS file.

        integer iunit,status,bitpix,naxis,naxes(99),pcount,gcount
        integer group,fpixel,nelem,i,jvals(3)
        integer ivalue(20),nrows,tfield,vardat,colnum,frow,felem
        real evals(3)
        logical simple,extend
        character*30 errtxt
        character*12 tform(2),ttype(2),tunit(2),extnam

        status=0
        iunit=15
C       open the new FITS file
        call ftinit(iunit,'simple.fit',2880,status)

C       write a 2D array 10 x 2 pixels in size
        simple=.true.
        bitpix=32
        naxis=2
        naxes(1)=10
        naxes(2)=2
        pcount=0
        gcount=1
        extend=.true.

C       write the required primary array keywords
        call ftphpr(iunit,simple,bitpix,naxis,naxes,pcount,gcount,
     &       extend,status)

C       write an additional integer keyword and a comment and history keyword:
        call ftpkyj(iunit,'jkey',-35,'The value is -35',status)
        call ftpcom(iunit,'This was written by FTPCOM',status)
        call ftphis(iunit,'This was written by FTPHIS',status)

C       set the values for the primary array
        nelem=naxes(1)*naxes(2)
        do 14 i=1,nelem
                ivalue(i)=i+64
14      continue

C       define the primary array structure
        call ftpdef(iunit,bitpix,naxis,naxes,pcount,gcount,status)

C       write the primary array of data
        group=1
        fpixel=1
        call ftpprj(iunit,group,fpixel,nelem,ivalue,status)

C       now create a binary table extension

C       first, create a new empty extension
        call ftcrhd(iunit,status)

C       table will have 3 rows and 2 columns (one integer*4 and one real*4)
        nrows=3
        tfield=2
        tform(1)='J'
        tform(2)='E'
        ttype(1)='IntVal'
        ttype(2)='RealVal'
        tunit(1)='cm'
        tunit(2)='kg'
        extnam='SIMPLETEST'
C       there are no variable length arrays so the size of the heap=0
        vardat=0

C       write the required keywords to the binary table extension
        call ftphbn(iunit,nrows,tfield,ttype,tform,tunit,extnam,
     &              vardat,status)

C       initialize the FITSIO parameters defining the structure of the table
        call ftbdef(iunit,tfield,tform,vardat,nrows,status)

C       write the integer column (column 1)
        jvals(1)=66
        jvals(2)=67
        jvals(3)=68
        colnum=1
        frow=1
        felem=1
        nelem=3
        call ftpclj(iunit,colnum,frow,felem,nelem,jvals,status)

C       write the real column (column 2)
        evals(1)=1000.
        evals(2)=1001.
        evals(3)=1002.
        colnum=2
        call ftpcle(iunit,colnum,frow,felem,nelem,evals,status)

C       now close the table and quit
        call ftclos(iunit,status)

        if (status .le. 0)then
                print *,'*** Program completed successfully ***'
        else
C          get the error text description
           call ftgerr(status,errtxt)
           print *,'*** ERROR - program did not run successfully ***'
           print *,'status =',status,': ',errtxt
        end if

        end
