cccc f77 fits_plot.f -o fits_plot.e -L/star/lib `cfitsio_link` `sla_link` -lpgplot -L/usr/lib64 -lX11 car_pltel.f -fno-second-underscore

      implicit none
       real tr(6),array(2000,2000),high,low,xpos,ypos,
     >angle,sxx,syy,sxy,ellip,peak,a,b,axpos(4),aypos(4)
      character*10 infile,fitsfile
      character*2880 header,string
 
      character*80 number
      character*4 charf77,dev1
      integer*2 data(4000000)
      integer nx,ny,start,end,nsuby,nsubx,h,v,
     > lowx,highx,lowy,highy,no,npix,dumpix
      integer status,unit,readwrite,blocksize,naxes(2),nfound
      integer group,firstpix,nbuffer,npixels,i,j,k,beg,end1,
     >chunk,posx,posy,pixcount,kk,ns,jf,noobj,startnum
      real datamin,datamax,nullval,buffer(100),sqsize
      real*8 c,ra,dec,rac,decc,pi,rac2000,decc2000,xi,eta,
     >xpl,ypl
      logical anynull
      character filename*10,rastring*11,decstring*9,conf*1
      integer nkeys,nspace,hdutype,f,jj
      character record*80,fieldstring*3,crastring*27,
     >cdecstring*27,xchar*5,ychar*5,lable*50,band1*6,
     >ylab*15,lowchar*7,highchar*7,argv*20

      parameter (pi=3.14159265359)
      parameter (c=3072.158)
           tr(1)=0.
           tr(2)=1.
           tr(3)=0.
           tr(4)=0.
           tr(5)=0.
           tr(6)=1.    
      status=0

      call getarg(1,argv)      
      read (argv,*) h
      call getarg(2,argv)
      read (argv,*) v      
      call getarg(3,argv)
      read (argv,*) sqsize
      dumpix=nint(100.*sqsize*60./67.14)

      call pgbegin (0,'gks74.ps/vps',h,v)
      call pgslw(3)
      call pgsch(2.0)

      open (unit=13,file='./plot.dat',status='old')

      do k=1,2000
         read (13,10,end=999)filename,conf,band1
      write (6,*) '.                                     '

 10      format (a10,9x,a1,3x,a6)

      if (conf .eq. 'y') then
      status=0
      call ftgiou(unit,status)
      readwrite=0
      call ftopen(unit,filename,readwrite,blocksize,status)
      call ftghsp(unit,nkeys,nspace,status)
C  Read each 80-character keyword record, and print it out.
      do i = 1, nkeys
          call ftgrec(unit,i,record,status)
         if (record(1:8).eq.'FIELDNUM') then
         fieldstring=record(12:14)
         end if

         if (record(1:7).eq.'OBJCTRA') then
         rastring=record(12:22)
         ns=1
         CALL sla_DAFIN (rastring, ns, ra, JF) 
         ra=ra*15.0
         end if

         if (record(1:8).eq.'OBJCTDEC') then
         decstring=record(12:20)
         ns=1
         CALL sla_DAFIN (decstring, ns, dec, JF) 
         end if

c         if (record(1:8).eq.'HKLIN022') then
c         crastring=record(25:51)
     
c         do kk=1,27
c         if (crastring(kk:kk).eq.'/') end1=kk-3
c         end do
c         read(crastring(1:end1),*)rac

c          rac=rac*15.0*pi/180.0
c         end if 
c         if (record(1:8).eq.'HKLIN023') then
c         cdecstring=record(25:51)
c         do kk=1,27
c         if (cdecstring(kk:kk).eq.'/') end1=kk-3
c         end do
c         read(cdecstring(1:end1),*)decc

c         decc=decc*pi/180.
c         end if 
       end do
c      CALL sla_FK45Z (rac,decc,1980.0D0,rac2000,decc2000) 
c
c      call sla_DS2TP (RA, DEC, rac2000, decc2000, XI, ETA, Jj)
c           xpl=xi*c
c           ypl=eta*c
c           xpl=177.8-xpl
c           ypl=177.8+ypl

      call ftclos(unit, status)
      call ftfiou(unit, status)
      status=0
      readwrite=0
      call ftopen(unit,filename,readwrite,blocksize,status)
C  Determine the size of the image.
      call ftgknj(unit,'NAXIS',1,2,naxes,nfound,status)
C  Check that it found both NAXIS1 and NAXIS2 keywords.
      if (nfound .ne. 2)then
          print *,'READIMAGE failed to read the NAXISn keywords.'
        
       end if
C  Initialize variables
      npixels=naxes(1)*naxes(2)
      group=1
      firstpix=1
      nullval=-999
      datamin=1.0E30
      datamax=-1.0E30
      chunk=0

      nx=naxes(1)
      ny=naxes(2)
      nsubx=naxes(1)
      nsuby=naxes(2)
       lowx=1
       highx=naxes(1)
       lowy=1
       highy=naxes(2)
      do while (npixels .gt. 0)
C         read up to 100 pixels at a time
          chunk=chunk+1
           nbuffer=min(100,npixels)
                call ftgpve(unit,group,firstpix,nbuffer,nullval,
     &            buffer,anynull,status)
C         find the min and max values
          do i=1,nbuffer
             pixcount=((chunk-1)*100)+i
             posy=1+aint(float(pixcount)/float(naxes(1)))
             posx=pixcount-(posy-1)*naxes(1)

             array(posx,posy)=buffer(i)
              datamin=min(datamin,buffer(i))
              datamax=max(datamax,buffer(i))
          end do
C         increment pointers and loop back to read the next group of pixels
          npixels=npixels-nbuffer
          firstpix=firstpix+nbuffer
      end do

      low=datamin
      high=datamax
C  The FITS file must always be closed before exiting the program. 
C  Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
      call ftclos(unit, status)
      call ftfiou(unit, status)
C  Check for any error, and if so print out error messages.
C  The PRINTERROR subroutine is listed near the end of this file.
      if (status .gt. 0) then
      write(6,*)'error'
       end if
      write(lowchar,59)low
      write(highchar,59)high
 59    format(f7.1)
      ylab=lowchar//' '//highchar
      write(xchar,61)xpl
      write(ychar,61)ypl
ccccccc      lable=rastring//' '//decstring//' '//fieldstring//' '
ccccccc     >//xchar//' '//ychar
      lable=rastring//' '//decstring
 61   format(f5.1)

          
      call pgenv(float(lowx),float(highx),float(lowy),float(highy),
     > 1,-2)
cccc      call pglabel(band1//' '//filename,ylab,lable) 
         call pglabel(band1//'  '//filename,' ',lable) 
cccc      call pggray(array,2000,2000,lowx,highx,lowy,highy,high,low,tr)
      call pggray(array,2000,2000,lowx,highx,lowy,highy,high,low,tr)    
 
      else
 444     continue
      lowx=1
      highx=dumpix
      lowy=1
      highy=dumpix
      call pgenv(float(lowx),float(highx),float(lowy),float(highy),
     > 1,-2)
      call pglabel(band1//' '//'not extracted',' ',' ')
      end if
      end do
 999  continue
 666  call pgend
            end

        










