        program test2

C       test program to read the FITS file created by program EXAMPLE1

        integer iunit,status,bitpix,naxis,naxes(99),pcount,gcount
        integer group,fpixel,nelem,htype,nkeys,nmore,block
        integer ivalue(10000),jval,imov,i
        logical simple,extend
        integer nrows,tfield,tbcol(10),rowlen
        character*8 ttype(10),tform(10),tunit(10)
        character*16 extnam
        character*8 carray(4)
        character comm*40 ,sval*10
        logical larray(4),lval,anyf
        integer*2 iarray(4),ival
        integer jarray(4)
        real farray(4),earray(4),eval,fval
        double precision darray(4),dval,gval
        complex comp(4),comval

        status=0
        iunit=15
C       open the existing FITS file
        call ftopen(iunit,'test1.fit',0,block,status)
        print *,'Opened existing FITS file:'
        print *,'ftopen block,status:',block,status

C       read the required primary array keywords
        call ftghpr(iunit,99,simple,bitpix,naxis,naxes,pcount,gcount,
     &       extend,status)
        print *,'Read required primary keywords: ftgprh status:',status
        print *,'  simple =',simple
        print *,'  bitpix =',bitpix
        print *,'  naxis =',naxis
        print *,'  naxes =',naxes(1),naxes(2)
        print *,'  pcount =',pcount
        print *,'  gcount =',gcount
        print *,'  extend =',extend
        print *,'Now read each keyword with no type conversion:'
        call ftgkyj(iunit,'jkey',jval,comm,status)
        print *,'JKEY:',jval,comm,status
        call ftgkyl(iunit,'lkey',lval,comm,status)
        print *,'LKEY:',lval,comm,status
        call ftgkys(iunit,'skey',sval,comm,status)
        print *,'SKEY:',sval,comm,status
        call ftgkye(iunit,'ekey',eval,comm,status)
        print *,'EKEY:',eval,comm,status
        call ftgkyd(iunit,'dkey',dval,comm,status)
        print *,'DKEY:',dval,comm,status
        call ftgkye(iunit,'fkey',fval,comm,status)
        print *,'FKEY:',fval,comm,status
        call ftgkyd(iunit,'gkey',gval,comm,status)
        print *,'GKEY:',gval,comm,status

        print *,'Now read back each keyword with datatype conversion:'
        call ftgkye(iunit,'jkey',eval,comm,status)
        print *,'ftgkye read JKEY with value, status =',eval, status
        call ftgkyd(iunit,'jkey',dval,comm,status)
        print *,'ftgkyd read JKEY with value, status =',dval, status
        call ftgkyj(iunit,'ekey',jval,comm,status)
        print *,'ftgkyj read EKEY with value, status =',jval, status
        call ftgkyj(iunit,'dkey',jval,comm,status)
        print *,'ftgkyj read DKEY with value, status =',jval, status
        call ftgkyj(iunit,'fkey',jval,comm,status)
        print *,'ftgkyj read FKEY with value, status =',jval, status
        call ftgkyj(iunit,'gkey',jval,comm,status)
        print *,'ftgkyj read GKEY with value, status =',jval, status

        print *,'Read string as an integer; should get error 403'
        jval=0
        call ftgkyj(iunit,'skey',jval,comm,status)
        print *,'ftgkyj read SKEY with value, status =',jval, status
        if (status .eq. 403)status=0

        print *,' '
        print *,'Now do the ASCII table extension...'
        call ftmrhd(iunit,1,htype,status)
        print *,'Moved to next HDU: ftmrhd htype,status',htype,status

        call ftghtb(iunit,10,rowlen,nrows,tfield,ttype,
     &   tbcol,tform,tunit,extnam,status)
        print *,'Read required table header: ftgtbh status',status
        print *,'  rowlen =',rowlen
        print *,'  nrows =',nrows
        print *,'  tfield =',tfield
        print *,'  ttype =',(ttype(i),i=1,tfield)
        print *,'  tbcol =',(tbcol(i),i=1,tfield)
        print *,'  tform =',(tform(i),i=1,tfield)
        print *,'  tunit =',(tunit(i),i=1,tfield)
        print *,'  extnam =',extnam

        print *,'Reading ASCII table with no implicit type conversion:'
        call ftgcvs(iunit,1,1,1,4,'NULL',carray,anyf,status)
        print *,'ftgcvs values, anyf,status=',carray,anyf,status
        call ftgcvj(iunit,2,1,1,4,-99,jarray,anyf,status)
        print *,'ftgcvj values, anyf,status',jarray,anyf,status
        call ftgcve(iunit,3,1,1,4,-99.,farray,anyf,status)
        print *,'ftgcve values, anyf,status',farray,anyf,status
        call ftgcve(iunit,4,1,1,4,-99.,earray,anyf,status)
        print *,'ftgcve values, anyf,status',earray,anyf,status
        dval=-99.
        call ftgcvd(iunit,5,1,1,4,dval,darray,anyf,status)
        print *,'ftgcvd values, anyf,status',darray,anyf,status

        print *,'Reading ASCII table with implicit type conversion:'
        call ftgcve(iunit,2,1,1,4,-999.,earray,anyf,status)
        print *,'ftgcve values, anyf,status',earray,anyf,status
        call ftgcvj(iunit,3,1,1,4,-999,jarray,anyf,status)
        print *,'ftgcvj values, anyf,status',jarray,anyf,status
        call ftgcvj(iunit,4,1,1,4,-999,jarray,anyf,status)
        print *,'ftgcvj values, anyf,status',jarray,anyf,status
        call ftgcvj(iunit,5,1,1,4,-999,jarray,anyf,status)
        print *,'ftgcvj values, anyf,status',jarray,anyf,status

        print *,' '
        print *,'Now do the binary extension...'
        call ftmrhd(iunit,1,htype,status)
        print *,'Moved to next HDU: ftmrhd htype,status',htype,status

        call ftghbn(iunit,10,nrows,tfield,ttype,tform,tunit,extnam,
     &    pcount,status)
        print *,'  nrows =',nrows
        print *,'  tfield =',tfield
        print *,'  ttype =',(ttype(i),i=1,tfield)
        print *,'  tform =',(tform(i),i=1,tfield)
        print *,'  tunit =',(tunit(i),i=1,tfield)
        print *,'  extnam =',extnam
        print *,'  pcount =',pcount
        print *,'Read required header: ftgbnh status',status

        print *,'Read back the data from the table (no conversion)'
        call ftgcvs(iunit,1,1,1,4,'NULL',carray,anyf,status)
        print *,'col 1 ftgcvs values, anyf,status=',carray,anyf,status
        call ftgcl(iunit,2,1,1,4,larray,status)
        print *,'col 2 ftgcl values, status=',larray,status
        ival=-99
        call ftgcvi(iunit,4,1,1,4,ival,iarray,anyf,status)
        print *,'col 4 ftgcvi values, anyf,status',iarray,anyf,status
        call ftgcvi(iunit,5,1,1,4,ival,iarray,anyf,status)
        print *,'col 5 ftgcvi values, anyf,status',iarray,anyf,status
        call ftgcvj(iunit,6,1,1,4,-99,jarray,anyf,status)
        print *,'col 6 ftgcvj values, anyf,status',jarray,anyf,status
        call ftgcve(iunit,7,1,1,4,-99.,earray,anyf,status)
        print *,'col 7 ftgcve values, anyf,status',earray,anyf,status
        dval=-99.
        call ftgcvd(iunit,8,1,1,4,dval,darray,anyf,status)
        print *,'col 8 ftgcvd values, anyf,status',darray,anyf,status
        comval=(-99.,99.)
        call ftgcvc(iunit,9,1,1,4,comval,comp,anyf,status)
        print *,'col 9 ftgcvc values, anyf,status',comp,anyf,status

        print *,'Read back the data from the table (with conversion)'
        dval=-999.
        call ftgcvd(iunit,4,1,1,4,dval,darray,anyf,status)
        print *,'col 4 ftgcvd values, anyf,status',darray,anyf,status
        call ftgcvd(iunit,5,1,1,4,dval,darray,anyf,status)
        print *,'col 5 ftgcvd values, anyf,status',darray,anyf,status
        call ftgcvd(iunit,6,1,1,4,dval,darray,anyf,status)
        print *,'col 6 ftgcvd values, anyf,status',darray,anyf,status
        call ftgcvj(iunit,7,1,1,4,-99,jarray,anyf,status)
        print *,'col 7 ftgcvj values, anyf,status',jarray,anyf,status
        call ftgcvj(iunit,8,1,1,4,-99,jarray,anyf,status)
        print *,'col 8 ftgcvj values, anyf,status',jarray,anyf,status
       
        call ftmahd(iunit,1,htype,status)
        print *,'Moved back to the primary array:'
        print *,'  ftmahd htype,status=',htype,status

        group=0
        fpixel=1
        nelem=20
 
        call ftgpvj(iunit,group,fpixel,nelem,0,ivalue,anyf,status)
        print *,'Read the primary array of data: ftgpvj status',status

        print *,(ivalue(i),i=1,20)

        imov=2
        call ftmrhd(iunit,imov,htype,status)
        print *,'Moved forward to the binary table again:'
        print *,'  ftmrhd htype,status=',htype,status

        call ftghsp(iunit,nkeys,nmore,status)
        print *,'Find space left in header: ftghsp:'
        print *,'nkeys,nmore,status',nkeys,nmore,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
