PROGRAM TASSPLOT
C
C program to plot tass variable star data
c mod from phaser 8-Aug-96 AAH
c mod to search all fields 15-dec-96 aah
C
      DIMENSION xmag(300),hjd(300)
      INTEGER iflag,jflag,xflag,npts,i,j,endflag,plotflag
      INTEGER idold,idnew,idreq
      REAL*4 size,xmin
      character fname*40,field*1,starname*5,oldname*5
c
c      get the data file name
c
      print *,' Tassplot version 1.0'
      print *,' Enter input file name: '
      read (5,'(a)') fname
      print *,' Enter faint mag cutoff (0.0=include all): '
      read (5,*) xflag
      print *,' Enter 0(display), 1(printer) 2(file): '
      read (5,*) iflag
      starname = ' '
      idreq = 0
c
c loop over stars
c
5     continue
      print *,' Enter starname to plot (xxx=all,yyy=end): '
      read (5,'(a)') starname
      if (starname.eq.'yyy') goto 600
      if (starname.ne.'xxx') read (starname,952) idreq
952   format (i)
      close(2)
      open (unit=2,file=fname,status='old')
c
c note: tass data is already grouped for each variable
c
      npts = 1
      endflag = 0
      plotflag = 0
      xmin = 1.e32
c remove header
10    continue
      read (2,950) field
950   format (a1)
      if (field.eq.'#') goto 10
      backspace (2)
c read initial starname
      read (2,922,end=400) idold
922   format (i5,21x,f10.4,1x,f6.3)
      backspace (2)
c read data for next star in file
300   continue
        read (2,922,end=400) idnew,hjd(npts),xmag(npts)
        if (idnew.eq.idold) then
          xmin = amin1(xmin,xmag(npts))
          npts=npts+1
          goto 300
        else
          backspace (2)
          goto 410
        endif
400   continue
      endflag = 1
410   continue
      npts = npts - 1
      write (oldname,951) idold
951   format (i5.5)
c
c now we have read data for one star.  check it against the
c desired list
c
      if ((starname.eq.'xxx'.and.xmin.lt.xflag)
     $    .or.(starname.eq.'xxx'.and.xflag.lt.8.0)
     $    .or.idold.eq.idreq) then
        call plotstar(oldname,hjd,xmag,npts,iflag,jflag)
        plotflag = 1
        if (jflag.eq.0) goto 600
      endif
      idold = idnew
      npts = 1
      xmin = 1.e32
      if (starname.eq.'xxx'.and.endflag.ne.1) goto 300
      if (starname.ne.'xxx'.and.plotflag.eq.1) goto 5
      if (starname.ne.'xxx') then
        if (endflag.ne.1) goto 300
        print *,' Star not found: ',starname
        goto 5
      endif
c
c end of plotting
c
600   continue
      close (2)
      stop
      end

      subroutine plotstar (name,x,y,npts,iflag,jflag)
c
c do actual plotting
c
      real x(npts),y(npts),xmin,xmax,ymin,ymax,x1
      integer iflag,jflag,kflag,npts,i,j
      CHARACTER  psfile*40,name*14,psname*10,
     $   encapstr*52,tlabel*25
      DATA psname /'postencap '/
      data kflag /0/
c
c start plot
c
      write (6,910) name
910   format (' Plotting: ',a5)
      IF (kflag.eq.0.and.iflag.eq.0) THEN
        i = sm_device('X11')
      ELSEIF (kflag.eq.0.and.iflag.eq.1) THEN
        i = sm_device('postscript')
      ELSEIF (kflag.eq.0) THEN
        print *,'Enter output filename: '
        read (5,'(a40)') psfile
        encapstr = psname//psfile
        i = sm_device(encapstr)
      ENDIF
      kflag = 1
      call sm_graphics
c
c do point plot
c
      xmax = -1.e32
      ymax = -1.e32
      xmin = 1.e32
      ymin = 1.e32
      x1 = x(1)
      do i=1,npts
         x(i) = x(i) - x1
         xmax = amax1(x(i),xmax)
         xmin = amin1(x(i),xmin)
         ymax = amax1(y(i),ymax)
         ymin = amin1(y(i),ymin)
      enddo
      xdelt = (xmax - xmin)*0.05
      ydelt = (ymax - ymin)*0.05
      xmax = xmax + xdelt
      ymax = ymax + ydelt
      xmin = xmin - xdelt
      ymin = ymin - ydelt
      call sm_limits (xmin,xmax,ymax,ymin)
      call sm_ctype('default')
      call sm_box (1,2,0,0)
      call sm_relocate(0.35*(xmax-xmin),(ymax+1.03*(ymin-ymax)))
      call sm_label (name(1:5))
      call sm_ylabel ('R')
      call sm_xlabel ('HJD')
      call sm_ctype('red')
      size = 2.
      call dots (x,y,npts,size)
      call sm_gflush
      call sm_ctype('default')
      IF (iflag.ne.0) call sm_hardcopy
      print *,' Do you want another star? (0=no,1=yes): '
      read (5,*) jflag
      if (jflag.eq.1) call sm_erase
      RETURN
      END

      SUBROUTINE DOTS (x,y,np,size)
c
c plot dots
c
      INTEGER np,j
      REAL*4 x(np),y(np),size
c
      call sm_expand(size)
      call sm_ptype (243.,1)
      call sm_points(x,y,np)
      call sm_expand(0.999999)
      return
      end