      program calplot
c     Fast Calplot
      integer*4 nfilt,ntime,nmax,fk,fknum
      parameter (nfilt=3,ntime=50,nmax=300)
      real*4 vis(nfilt,ntime),viserr(nfilt,ntime)
      real*4 time(ntime),y(ntime)
      real*4 vismax(nfilt),vismin(nfilt),lambda(nfilt)
      real*4 errsum(nfilt),vismean(nfilt),vismerr(nfilt)
      character header*80,device*4,fname*80,fknam*6
      character*80 data(49000)
      integer done
      integer nerr(nfilt)
      integer*4 i,icount
      logical first
      done=0
      blank=' '
      open(1,file='e:\\cal\\allcal.bin',status='old',err=10)
      read(1)data
      goto 321
   10 write(6,*)' Enter name of concatenated .CAL file!'
      write(6,*)' Include .CAL or .BIN extension;'
      write(6,*)' .CAL file will be transformed to binary'
      write(6,*)' .BIN file for faster reading!'
      write(6,*)' Attention! No more than 49000  lines!'
      read(5,3,end=10)fname
    3 format(a80)
      indx=0
      indx=max(index(fname,'.CAL'),index(fname,'.cal'))
      if(indx.ne.0)then
       open(2,file=fname,err=10,status='old')
       open(1,file=fname(1:indx-1)//'.bin')
       write(6,*)' reading .cal file...'
       n=1
       do i=1,49000
        read(2,3,end=123)data(n)
        if(data(n)(1:10).ne.'          ')n=n+1
       enddo
  123  write(6,*)i-1,' lines read.'
       write(1)data
      else
       open(1,file=fname,err=10,status='old')
       read(1)data
      endif
  321 write(6,*)' Screen (s) or hardcopy (h) ?'
      read(5,3)device
      if(device.eq.'h'.or.device.eq.'H')then
       device='/lpm'
       iy=4
       csize=3.0
      else
c     if(device.eq.'s'.or.device.eq.'S')then
       device='/ega'
       iy=3
       csize=2.5
      endif
   20 write(6,*)' Enter FK number of star (n/0 to stop)!'
      first=.true.
      read(5,'(a)',end=114)fknam
      if(index(fknam,'n').ne.0)goto 114
      read(fknam,*)fknum
      open(3,file=fknam//'.cal')
      if(fknum.eq.0)goto 114
      fknam='      '
      write(fknam(2:5),'(i4)')fknum
      call pgbegin(0,device,3,iy)
      call pgsch(csize)
      icount=1
  100 if(done.eq.1)goto 113
      call lock(data,icount,fknam,done)
      if(done.eq.1)goto 113
      do i=1,nfilt
      vismax(i)=0
      vismin(i)=0
      errsum(i)=0
      vismean(i)=0
      vismerr(i)=0
      nerr(i)=0
      enddo
      timmin=6
      timmax=6
      ndat=1
      read(data(icount),*,end=113)date,bl,lambda(1),lambda(2),lambda(3)
      if(first)then
       write(3,2)data(icount)
       first=.false.
      endif
    2 format(a80)
      do 110 n=1,nmax
      if(ndat.gt.ntime)then
       write(6,*)'*** ERROR: more than ',ntime,' scans for this star!'
       write(6,*)'*** STOP.'
       done=1
       goto 111
      endif
      icount=icount+1
      read(data(icount),*,end=112)time(ndat)
      if(time(ndat).eq.0.and.index(data(icount),'0.00').eq.0)goto 112
      if(time(ndat).gt.24)then
       goto 111
      endif
      read(data(icount),*,end=110,err=110)
     &time(ndat),fk,d1,vis(1,ndat),viserr(1,ndat),
     &d2,vis(2,ndat),viserr(2,ndat),d3,vis(3,ndat),viserr(3,ndat)
      if(fk.eq.fknum)then
      write(3,2)data(icount)
      do j=1,nfilt
       if(vis(j,ndat).ne.2)then
       vismax(j)=max(vismax(j),vis(j,ndat))
       vismin(j)=min(vismin(j),vis(j,ndat))
       if(viserr(j,ndat).eq.0)viserr(j,ndat)=1.0
       endif
      enddo
      timmax=max(timmax,time(ndat))
      timmin=min(timmin,time(ndat))
      ndat=ndat+1
      endif
  110 continue
  111 ndat=ndat-1
      if(ndat.eq.0)goto 100
      do j=1,nfilt
      call pgsci(5)
      timr=timmax-timmin
      timmin=timmin-timr/10.
      timmax=timmax+timr/10.
      vr=vismax(j)-vismin(j)
      vismax(j)=vismax(j)+vr/8.
      call pgenv(timmin,timmax,vismin(j),vismax(j),0,1)
      write(header,1)fknum,int(date),int(bl),int(lambda(j))
    1 format('FK# ',i4,1x,i6,1x,' B.l. ',i2,1x,i3,' nm')
      csize=csize+1
      call pgsch(csize)
      call pglabel('','',header)
      csize=csize-1
      call pgsch(csize)
      if(j.eq.1)call pgsci(2)
      if(j.eq.2)call pgsci(4)
      if(j.eq.3)call pgsci(3)
      do i=1,ndat
      y(i)=vis(j,i)
      if(y(i).ne.2)then
      call pgpoint(1,time(i),y(i),1)
      vislo=vis(j,i)-viserr(j,i)
      vishi=vis(j,i)+viserr(j,i)
      call pgerry(1,time(i),vislo,vishi,1.0)
      vismean(j)=vismean(j)+y(i)/viserr(j,i)/viserr(j,i)
      vismerr(j)=vismerr(j)+1./viserr(j,i)/viserr(j,i)
      endif
      enddo
      enddo
      if(done.eq.1)goto 113
      goto 100
  112 done=1
      goto 111
  113 call pgend
      write(6,*)' Stopped search at line ',icount
      do j=1,nfilt
      if(vismerr(j).ne.0)then
      vismean(j)=vismean(j)/vismerr(j)
      endif
      do i=1,ndat
      if(vis(j,i).ne.2)then
      errsum(j)=errsum(j)+(vismean(j)-vis(j,i))**2/(viserr(j,i)**2)
      nerr(j)=nerr(j)+1
      endif
      enddo
      if(nerr(j).ne.0)then
      errsum(j)=errsum(j)/float(nerr(j))
      endif
      enddo
      write(6,*)' Last star: chi^2/N = ',(errsum(j),j=1,nfilt)
      write(6,*)'   rel. to mean vis = ',(vismean(j),j=1,nfilt)
      done=0
      icount=1
      goto 20
  114 end
c****************************************************************
      subroutine lock(data,icount,fknam,done)
      character*80 data(8)
      character fknam*6
      integer*4 icount,done
c
      i1=icount
      done=0
      do icount=i1,49000
       if(index(data(icount),fknam).ne.0)then
        read(data(icount),*)time
        if(time.lt.24)then
         do j=1,300     ! Maximum number of scans in one night
          read(data(icount-j),*)time
          if(time.gt.24)then
c          read(data(icount-j),*)date,bl,lambda(1),lambda(2),lambda(3)
           goto 111
          endif
         enddo
        endif
       endif
      enddo
      done=1
      icount=49000
      return
c
  111 icount=icount-j
      return
      end

