cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
cc                     Version 1.1                        cc
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

c penplot-like package. Produces Tektronix output.
c
c  calls
c  
c  scale
c    initializes from parameters in scale.plt
c  window(xmin,ymin,xmax,ymax)
c    initializes, sets lower left and upper right corner, enters graphics mode
c  view(xvmin,yvmin,xvmax,yvmax)
c    sets viewport. Screen is 0,0,100,100 (default)
c  plot(x,y)
c    if pen is up, moves to new point (x,y), lowers pen
c    if pen is down, draws line to new point (x,y)
c  penup
c    raises pen
c  endplt
c    finishes plot (flushes buffer)
c  erase
c    erases screen
c  gmode
c    put into graphics mode
c  tmode
c    put into text mode
c    on an xterm window, puts focus back in vt102 window
c  readvar(fn,names,values,num)
c    reads a .var type of file named fn
c    returns real values for each of the variables 1..num named
c    in the names array.
c  readvara(fn,names,valuesa,num)
c    same but returns ascii character*20 strings instead
c
c  22 May 08.  WJS
c	Newer compiler did not like the implicit equivalence in
c    the call to readvar in scale.  Replace it w/an explicit
c    equivalence.  
c	Bug fix: char string dummies shouldn't have fixed length

c
      subroutine readvar(fn,names,values,num)
      character*(*) fn
      character*20 names(150)
      real values(150)
      character*80 st
      open(unit=1,file=fn(1:in_lnblnk(fn)),status='old')
 100  read(1,1,end=999)st
 1    format(a)
      if(index(st,'#').gt.1)then
         st=st(1:index(st,'#')-1)
      else if(index(st,'#').eq.1)then
         goto 100
      endif
      j=index(st,'=')
      if(j.eq.0)goto 100
      do 10 i=1,num
         if(st(1:j-1).eq.names(i))read(st(j+1:in_lnblnk(st)),*)values(i)
 10      continue
      goto 100
 999  close(1)
      return
      end

      subroutine readvara(fn,names,values,num)
      character*(*) fn
      character*20 names(150),values(150)
      character*80 st
      open(unit=1,file=fn(1:in_lnblnk(fn)),status='old')
 100  read(1,1,end=999)st
 1    format(a)
      if(index(st,'#').gt.1)then
         st=st(1:index(st,'#')-1)
      else if(index(st,'#').eq.1)then
         goto 100
      endif
      j=index(st,'=')
      if(j.eq.0)goto 100
      do 10 i=1,num
         if(st(1:j-1).eq.names(i))values(i)=st(j+1:in_lnblnk(st))
 10      continue
      goto 100
 999  close(1)
      return
      end

        subroutine tekmode
        include 'penplot.com'
        if(xtermfl.eq.-1)then
           xtermfl=1
           call pointqq(27)
           call pointqq(91)
           call pointqq(63)
           call pointqq(51)
           call pointqq(56)
           call pointqq(104)
           endif
        return
        end

	subroutine tmode
	include 'penplot.com'
	call pointqq(31)
      if (xtermfl.eq.1)then
         call pointqq(27)
         call pointqq(3)
        xtermfl=-1
          endif
	return
	end

	subroutine gmode
	include 'penplot.com'
        call tekmode
	call pointqq(29)
	return
	end

        block data
	include 'penplot.com'
        data xv0,yv0,xv1,yv1/0.0,0.0,100.0,100.0/
        data x0,y0,x1,y1/0.0,0.0,1.0,1.0/
        data ax,bx,ay,by/0.01,0.0,0.01,0.0/
        data p9,hy0,ly0,llx0,lly0,hx0,lx0/0,-1,-1,-1,-1,-1,-1/
        data xtermfl/0/
        end

        subroutine view(xva,yva,xvb,yvb)
        character*20 envval
	include 'penplot.com'
        call getenv('TERM',envval)
        if(envval.eq.'xterm')then
           xtermfl= -1
        else
           xtermfl = 0
        endif
c        write(*,*)'xtermfl',xtermfl
        call tekmode
	call pointqq(29)

        xv0=xva
        yv0=yva
        xv1=xvb
        yv1=yvb
        ax=(xv1-xv0)/(x1-x0)
        bx=-ax*x0+xv0
        ay=(yv1-yv0)/(y1-y0)
        by=-ay*y0+yv0
	p9=0
	hx0=-1
	hy0=-1
	lx0=-1
	ly0=-1
	return
	end

	subroutine window(xa,ya,xb,yb)
        character*20 envval
	include 'penplot.com'
        call getenv('TERM',envval)
        if(envval.eq.'xterm')then
           xtermfl= -1
        else
           xtermfl = 0
        endif
c        write(*,*)'xtermfl',xtermfl
        call tekmode
	call pointqq(29)
        x0=xa
        y0=ya
        x1=xb
        y1=yb
        ax=(xv1-xv0)/(x1-x0)
        bx=-ax*x0+xv0
        ay=(yv1-yv0)/(y1-y0)
        by=-ay*y0+yv0

	p9=0
	hx0=-1
	hy0=-1
	lx0=-1
	ly0=-1
	return
	end

	subroutine endplt
	include 'penplot.com'
	call pointqq(31)
c	write(*,*)'after leadout'
        call tmode
c	write(*,*)'after tsend'
	return
	end

	subroutine penup
	include 'penplot.com'
	call pointqq(29)
	P9=0
	return
	end

	subroutine erase
	include 'penplot.com'
	call pointqq(31)
	call pointqq(27)
	call pointqq(12)
	call pointqq(29)
        call cflush(6)
	p9=0
	return
	end

	subroutine plot(x,y)
	include 'penplot.com'
        integer hx,hy,lx,ly,llx,lly
        xp=ax*x+bx
        yp=ay*y+by
        if(xp.lt.xv0-0.001 .or. xp.gt.xv1+0.001 .or. 
     $        yp.lt.yv0-0.001 .or. yp.gt.yv1+0.001)then
           call penup
           return
           endif
          ix=xp*40.95+.4999999
          iy=yp*31.19+.4999999

	hy=iy/128
	lly=iy-128*hy
        ly=lly/4
        lly=lly-4*ly
	hx=ix/128
	llx=ix-128*hx
        lx=llx/4
        llx=llx-4*lx

	i=0
	if(hy.ne.hy0)then
		i=i+1
		call pointqq(hy+32)
	endif

        if(lly.ne.lly0 .or .llx.ne.llx0)then
           i=i+1
           call pointqq(96+4*lly+llx)
           i=i+1
           call pointqq(ly+96)
         elseif(ly.ne.ly0 .or. hx.ne.hx0)then
		i=i+1
		call pointqq(ly+96)
	endif

	if(hx.ne.hx0)then
		i=i+1
		call pointqq(hx+32)
	endif

	i=i+1
	call pointqq(lx+64)

	hy0=hy
	ly0=ly
	hx0=hx
	lx0=lx
        lly0=lly
        llx0=llx
	return
	end

	subroutine plota(xp,yp)
	include 'penplot.com'
	integer hx,hy,lx,ly,llx,lly
        if(xp.lt.0.0 .or. xp.gt.100.0 .or. 
     $        yp.lt.0.0 .or. yp.gt. 100.0)then
           call penup
           return
           endif
          ix=xp*40.95+.4999999
          iy=yp*31.19+.4999999

	hy=iy/128
	lly=iy-128*hy
        ly=lly/4
        lly=lly-4*ly
	hx=ix/128
	llx=ix-128*hx
        lx=llx/4
        llx=llx-4*lx

	i=0
	if(hy.ne.hy0)then
		i=i+1
		call pointqq(hy+32)
	endif

        if(lly.ne.lly0 .or .llx.ne.llx0)then
           i=i+1
           call pointqq(96+4*lly+llx)
           i=i+1
           call pointqq(ly+96)
         elseif(ly.ne.ly0 .or. hx.ne.hx0)then
		i=i+1
		call pointqq(ly+96)
	endif

	if(hx.ne.hx0)then
		i=i+1
		call pointqq(hx+32)
	endif

	i=i+1
	call pointqq(lx+64)

	hy0=hy
	ly0=ly
	hx0=hx
	lx0=lx
        lly0=lly
        llx0=llx
	return
	end

	subroutine scale
        character*20 envval
	include 'penplot.com'
        character*20 names(8)
	dimension vals(8)
	equivalence (vals,xv0)
        data names/'xvmin','yvmin','xvmax','yvmax',
     $         'xmin','ymin','xmax','ymax'/
        call getenv('TERM',envval)
        if(envval.eq.'xterm')then
           xtermfl= -1
        else
           xtermfl = 0
        endif
c        write(*,*)'xtermfl',xtermfl
        call tekmode
	call pointqq(29)

        call readvar('plot.var',names,vals,8)
c    relies on order in penplot.com and names above.
c        call tmode
c        write(*,*)xv0,yv0,xv1,yv1,x0,y0,x1,y1
c        call tekmode
        ax=(xv1-xv0)/(x1-x0)
        bx=-ax*x0+xv0
        ay=(yv1-yv0)/(y1-y0)
        by=-ay*y0+yv0

	p9=0
	hx0=-1
	hy0=-1
	lx0=-1
	ly0=-1
	return
	end




