	program vartst
C	program to test the FITSIO subroutine package by creating a
C       binary table with variable length arrays

        integer iunit,status,bitpix,naxis,naxes(99),pcount,gcount,i,j
        logical simple,extend
        integer nelem,offset,nrows,tfield,icol,ecol
        character*16 ttype(10),tform(10),tunit(10),extnam
        logical anyf
        integer*2 iarray(30),ival
        real earray(30),eval

        status=0
        iunit=15
C	open the new FITS file
        call ftinit(iunit,'testvari.fit',2880,status)
        print *,'Opened new FITS file: ftinit status:',status

        simple=.true.
        bitpix=8
        naxis=0
        pcount=0
        gcount=1
        extend=.true.

C	write the required primary array keywords
        call ftpprh(iunit,simple,bitpix,naxis,naxes,pcount,gcount,
     &       extend,status)
        print *,'Wrote required primary keywords: ftpprh status:',status

        call ftpdef(iunit,bitpix,naxis,naxes,pcount,gcount,status)
        print *,'Defined array structure: ftpdef status',status

	print *,' '
	print *,'Now do the binary extension...'
        call ftcrhd(iunit,status)
        print *,'Created new HDU: ftcrhd status',status

        nrows=30
        tfield=2
        ttype(1)='I_Field'
        ttype(2)='E_field'
        tform(1)='PI'
        tform(2)='PE'
        tunit(1)=' '
        tunit(2)=' '
        extnam='Test-VARIABLE'

C       reserve enough heap space for the variable length arrays
        pcount=2800

        call ftpbnh(iunit,nrows,tfield,ttype,tform,tunit,extnam,
     &    pcount,status)
        print *,'Wrote required header: ftpbnh status',status

        call ftbdef(iunit,tfield,tform,pcount,nrows,status)
        print *,'Defined table structure: ftbdef status',status

C	initialize table values
        do 10 i=1,30
                iarray(i)=i
                earray(i)=i
10      continue

C       write the data, one row at a time
        icol=1
        ecol=2
        do 20 i=1,30
            call ftpcli(iunit,icol,i,1,i,iarray,status)
            call ftgdes(iunit,icol,i,nelem,offset,status)
            print *,'colnum, row, nelem, offset=',icol,i,nelem,offset
            call ftpcle(iunit,ecol,i,1,i,earray,status)
            call ftgdes(iunit,ecol,i,nelem,offset,status)
            print *,'colnum, row, nelem, offset=',ecol,i,nelem,offset
20      continue
        print *,'Wrote the variable length data. Status=',status

C       now read the I*2 data back and print it out
C       set the null pixel values
        ival=-99
        do 30 i=1,30
                call ftgcvi(iunit,icol,i,1,i,ival,iarray,anyf,status)
                print *,(iarray(j),j=1,i)
30      continue
        print *,'ftgcvi status =',status

C       now read the r*4 data back and print it out
C       set the null pixel values
        eval=-99.
        do 40 i=1,30
                call ftgcve(iunit,ecol,i,1,i,eval,earray,anyf,status)
                print *,(earray(j),j=1,i)
40      continue
        print *,'ftgcve status =',status

        call ftclos(iunit,status)
        print *,'Closed FITS file: ftclos status',status

	if (status .le. 0)then
		print *,'*** Program completed successfully ***'
	else
	   print *,'*** ERROR - program did not run successfully ***'
	end if

        end
