c
c
      subroutine algplt (amin,amax,axmax,orig,cycle)
c
c
        write (7,2) 'algplt'
    2    format (a6)
        write (7,*) amin,amax,axmax,orig,cycle
c
        return
c
      end 
c
c
c------------------------------------------------------------------
c
c
      subroutine area2d (xaxis,yaxis)
c
c
        write (7,2) 'area2d'
    2    format (a6)
        write (7,*) xaxis,yaxis
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine axsplt (amin,amax,axmax,orig,step,axis)
c
c
        write (7,2) 'axsplt'
    2    format (a6)
        write (7,*) amin,amax,axmax,orig,step,axis
c
        return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine bangle (ang) 
c
        write (7,2) 'bangle'
    2    format (a6)
        write (7,*) ang
c
      return
c
      end 
c
c
c-------------------------------------------------------------------
c
c
      subroutine basalf ( alfnam )
c
      character*(*) alfnam
c
      write (7,2) 'basalf'
   2   format ( a6 )
      write (7,600) alfnam
 600   format ( a ) 
c
      return
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine bgnpl (ibegin)
c
c
c-------write (7,*) 'bgnpl '
c-------write (7,*) ibegin
c
        write (7,2) 'reset '
    2    format (a6)
        write (7,'(a3)') 'all'
c
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine comprs
      common /hwblk/ hws
      logical hws
c
      character*25  plfile
c
  10  print *, ' Type in name for plot file '
      print *, '   (25 characters or less) '
c----      read (*, *, err = 10) plfile
c
      plfile = 'plfile'
      print *, ' File name set to "plfile" in COMPRS (in dsp205.f) '
c
      hws=.false.
c
        open ( 7 , file=plfile ) 
c
        write (7,2) 'comprs'
    2    format (a6)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine curve (xaray,yaray,npnts,imark)
c
      dimension xaray(npnts),yaray(npnts)
c
        write (7,2) 'curve '
    2    format (a6)
        write (7,*) npnts,imark
        do 100 i=1,npnts
         write (7,*) xaray(i),yaray(i)
  100   continue
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine dash
c
c
        write (7,2) 'dash  '
    2    format (a6)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine donepl
c
c
        write (7,2) 'donepl'
    2    format (a6)
c
        close ( 7 , status='keep' )
c
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine dot
c
c
        write (7,2) 'dot   '
    2    format (a6)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine endpl (iplot)
      common /hwblk/ hws
      logical hws
c
        write (7,2) 'endpl '
    2    format (a6)
        write (7,*) iplot
      if(hws) write(7,*) 'continue'
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine frame
c
c
        write (7,2) 'frame '
    2    format (a6)
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine graf (xorig,xdum,xmax,yorig,ydum,ymax)
c
c
              write (7,2) 'graf  '
    2    format (a6)
      xdummy = 0.
      ydummy = 0.
              write (7,*) xorig,xdummy,xmax,yorig,ydummy,ymax
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine graf3d ( x3orig, xdum, x3max, y3orig, ydum, y3max,
c
     1                    z3orig, zdum, z3max )
c
c
      write (7,2) 'graf3d'
    2 format ( a6 ) 
      xdummy = 0.0
      ydummy = 0.0
      zdummy = 0.0
      write (7,*) x3orig, xdummy, x3max, y3orig, ydummy, y3max,
     1            z3orig, zdummy, z3max 
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine headin (lhead,ihead,htmult,nlines)
c
      character*(*) lhead
c
c
      idol=index(lhead,'$')
      if(idol.eq.0) idol=ihead
c
        write (7,2) 'headin'
    2    format ( a6 )
        write (7,200) lhead(1:idol)
  200   format (a)
        write (7,*) ihead,htmult,nlines 
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine height (hite)
c
c
        write (7,2) 'height'
    2    format (a6)
        write (7,*) hite
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine hldplt
c
c
        write (7,2) 'hldplt'
    2    format (a6)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------
c
c
      subroutine hwspec(file,hw)
      character*(*) file, hw
      common /hwblk/ hws
      logical hws
c
      hws=.true.
c
      write(7,2) 'hwspec'
    2    format (a6)
      write(7,200) file
      write(7,200) hw
200   format(a)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------
c
c
      subroutine intaxs
c
c
        write (7,2) 'intaxs'
    2    format (a6)
c
        return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine intno (inum,xpos,ypos) 
c
c
      character*4 abut
c
        write (7,2) 'intno '
    2    format (a6)
c
        write ( abut, '(a4)' ) xpos
c
        if ( abut .eq. 'abut' ) then
                                     write (7,*) '.true.'
                                   write (7,*) inum,' abut',' abut'
                            else
                                 write (7,*) '.false.'
                               write (7,*) inum,xpos,ypos
        end if
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine linplt (xaray,yaray,npnts)
c
      dimension xaray(npnts),yaray(npnts)
c
c
        write (7,2) 'linplt'
    2    format (a6)
        write (7,*) npnts
        do 300 i=1,npnts
         write (7,*) xaray(i),yaray(i)
  300   continue
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine loglog (xorig,xcycle,yorig,ycycle)
c
c
        write (7,2) 'loglog'
    2    format (a6)
        write (7,*) xorig,xcycle,yorig,ycycle
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine logplt (xaray,yaray,npnts)
c
      dimension xaray(npnts),yaray(npnts)
c
c
        write (7,2) 'logplt'
    2    format (a6)
        write (7,*) npnts
        do 400 i=1,npnts
         write (7,*) xaray(i),yaray(i)
  400   continue
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine marker (isym)
c
c
        write (7,2) 'marker'
    2    format (a6)
        write (7,*) isym
c
      return
c
      end 
c
c
cc--------------------------------------------------------------------
c
c
      subroutine messag (lmess,imess,xpos,ypos)
c
      character*(*) lmess
      character*4 abut
c
c
      idol=index(lmess,'$')
      if(idol.eq.0) idol=imess
c
        write (7,2) 'messag'
    2    format (a6)
c
      if(idol.le.75) then
                          write(7,499) lmess(1:idol)
  499                  format(a)
                          write (7,*) '      '
                  else
                       write (7,500) lmess(1:75),lmess(76:idol)
  500               format (75a/a)
      end if
c
      write ( abut, '(a4)' ) xpos
c
      if ( abut .eq. 'abut' ) then
                                   write (7,*) '.true.'
                               write (7,*) imess,' abut',' abut'
                         else 
                              write (7,*) '.false.'
                             write (7,*) imess,xpos,ypos
      end if
c
      return
c
      end 
c
c
c-------------------------------------------------------------------
c
c
      subroutine mixalf ( alfnam )
c
      character*(*) alfnam
c
      write (7,2) 'mixalf'
   2   format ( a6 )
      write (7,600) alfnam
 600   format ( a ) 
c
      return
      end 
c
c-------------------------------------------------------------------
c
      subroutine mx1alf ( alfnam , chanam )
c
      character*(*)  alfnam, chanam
c
      write (7,'(a6)') 'mx1alf'
      write (7,'(a)') alfnam
      write (7,'(a)') chanam
c
      return
      end 
c
c-------------------------------------------------------------------
c
      subroutine mx2alf ( alfnam , chanam )
c
      character*(*)  alfnam, chanam
c
      write (7,'(a6)') 'mx2alf'
      write (7,'(a)') alfnam
      write (7,'(a)') chanam
c
      return
      end 
c
c-------------------------------------------------------------------
c
      subroutine mx3alf ( alfnam , chanam )
c
      character*(*)  alfnam, chanam
c
      write (7,'(a6)') 'mx3alf'
      write (7,'(a)') alfnam
      write (7,'(a)') chanam
c
      return
      end 
c
c-------------------------------------------------------------------
c
      subroutine mx4alf ( alfnam , chanam )
c
      character*(*)  alfnam, chanam
c
      write (7,'(a6)') 'mx4alf'
      write (7,'(a)') alfnam
      write (7,'(a)') chanam
c
      return
      end 
c
c-------------------------------------------------------------------
c
      subroutine mx5alf ( alfnam , chanam )
c
      character*(*)  alfnam, chanam
c
      write (7,'(a6)') 'mx5alf'
      write (7,'(a)') alfnam
      write (7,'(a)') chanam
c
      return
      end 
c
c-------------------------------------------------------------------
c
      subroutine mx6alf ( alfnam , chanam )
c
      character*(*)  alfnam, chanam
c
      write (7,'(a6)') 'mx6alf'
      write (7,'(a)') alfnam
      write (7,'(a)') chanam
c
      return
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine nobrdr
c
c
        write (7,2) 'nobrdr'
    2    format (a6)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------
c
c
      subroutine qms2
c
      common /hwblk/ hws
      logical  hws
c
      character*25  plfile
c
  10  print *, ' Type in name for plot file '
      print *, '   (25 characters or less) '
c----      read (*, *, err = 10) plfile
c
      plfile = 'plfile'
      print *, ' File name set to "plfile" in subr QMS2 (in dsp205.f) '
c
      hws = .false. 
c
c
        open ( 7 , file = plfile )
c
c
        write (7,2) 'qms2  '
    2     format (a6)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine page (pagex,pagey)
c
c
        write (7,2) 'page  '
    2    format (a6)
        write (7,*) pagex,pagey
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine physor (xphys,yphys)
c
c
        write (7,2) 'physor'
    2    format (a6)
        write (7,*) xphys,yphys
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine ptekal
c
      common /hwblk/ hws
      logical hws
c
      character*25  plfile
c
  10  print *, ' Type in name for plot file '
      print *, '   (25 characters or less) '
c----      read (*, *, err = 10) plfile
c
      plfile = 'plfile'
      print *, ' File name set to "plfile" in PTEKAL (in dsp205.f) '      
c
      hws=.false.
      imodel = 4014 
      linesp = 960
      iresno = 1
      ioptn  = 0
c
c
        open ( 7 , file=plfile ) 
c
c
        write (7,2) 'ptekal'
    2    format (a6)
        write (7,*) imodel
        write (7,*) linesp
        write (7,*) iresno
        write (7,*) ioptn
c
      return
c
         end
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine realno ( anum, iplace, xpos, ypos )
c
c
      character*4 abut
c
      write (7,2) 'realno'
    2    format (a6)
c
      write ( abut, '(a4)' ) xpos
c
      if ( abut .eq. 'abut' ) then
                                   write (7,*) '.true.'
                            write (7,*) anum,iplace,' abut',' abut'
                      else
                           write (7,*) '.false.'
                         write (7,*) anum,iplace,xpos,ypos
      end if
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine reset (opname)
c
      character*(*) opname
c
c
        write (7,2) 'reset '
    2    format (a6)
        write (7,600) opname
  600   format (a)
c
      return
c
      end 
c
c
c----------------------------------------------------------------------
c
c
      subroutine scmplx
c
      write (7,'(a6)') 'scmplx'
c
      return
      end 
c
c
c----------------------------------------------------------------------
c
c
      subroutine setdev ( ierr, isum )
c
      write (7,2) 'setdev'
    2 format ( a6 ) 
c
      write (7,*) ierr, isum
c
      return
      end 
c
c
c-----------------------------------------------------------------------
c
c
      subroutine surmat ( zmat, ixpts, ixdim, iypts, iydim, zero )
c
c
      dimension  zmat(ixdim,iydim)
c
      write (7,2) 'surmat'
    2 format ( a6 ) 
      write (7,*) ixpts, ixdim, iypts, iydim, zero
c
      write (7,10) ( ( zmat(i,j), i=1,ixdim ), j=1,iydim )
   10 format ( 1p8e10.3 )
c
      return
      end 
c
c
c-------------------------------------------------------------------------
c
c
      subroutine surtrn ( trans )
c
c
      character*(*)  trans
c
      write (7,2) 'surtrn'
    2 format ( a6 ) 
c
      write (7,600) trans
  600 format ( a )
c
      return
      end 
c
c
c------------------------------------------------------------------------
c
c
      subroutine survis ( vis )
c
c
      character*(*)  vis
c
      write (7,2) 'survis'
    2 format ( a6 ) 
c
      write (7,600) vis
  600 format ( a )
c
      return
      end 
c
c----------------------------------------------------------------------
c
c
      subroutine title (ltitle,ititle,lxname,ixname,lyname,iyname,
c
     1                  xaxis,yaxis)
c
      character*(*) ltitle,lxname,lyname
c
c
      idol1=index(ltitle,'$') 
      if(idol1.eq.0) idol1=ititle
      idol2=index(lxname,'$') 
      if(idol2.eq.0) idol2=ixname
      idol3=index(lyname,'$') 
      if(idol3.eq.0) idol3=iyname
        write (7,2) 'title '
    2    format (a6)
        write (7,700) ltitle(1:idol1)
  700   format (a)
        write (7,700) lxname(1:idol2)
        write (7,700) lyname(1:idol3)
        write (7,*) ititle,ixname,iyname
        write (7,*) xaxis,yaxis
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine tk4014(linesp,ires)
c
      common /hwblk/ hws
      logical hws
c
      character*25  plfile
c
  10  print *, ' Type in name for plot file '
      print *, '   (25 characters or less) '
c----      read (*, *, err = 10) plfile
c
      plfile = 'plfile'
      print *, ' File name set to "plfile" in TK4014 (in dsp205.f) '
c
      hws=.false.
c
      open ( unit=7 , file = plfile )
c
      write(7,2) 'tk4014'
    2    format (a6)
c
      write(7,*) linesp
      write(7,*) ires
c
      return
c
      end 
c
c
c----------------------------------------------------------------------
c
c
      subroutine volm3d ( x3axis, y3axis, z3axis )
c
      write (7,2) 'volm3d'
    2 format ( a6 ) 
c
      write (7,*) x3axis, y3axis, z3axis
c
      return
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine vuabs ( xvu, yvu, zvu )
c
      write (7,2) 'vuabs '
    2 format ( a6 ) 
c
      write (7,*) xvu, yvu, zvu
c
      return
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine xaxang (ang) 
c
c
        write (7,2) 'xaxang'
    2    format (a6)
        write (7,*) ang
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine xintax
c
c
        write (7,2) 'xintax'
    2    format (a6)
c
        return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine xlgplt (xaray,yaray,npnts)
c
      dimension xaray(npnts),yaray(npnts)
c
c
        write (7,2) 'xlgplt'
    2    format (a6)
        write (7,*) npnts
        do 800 i=1,npnts
         write (7,*) xaray(i),yaray(i)
  800   continue
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine xlog (xorig,xcycle,yorig,ystep)
c
c
        write (7,2) 'xlog  '
    2    format (a6)
        write (7,*) xorig,xcycle,yorig,ystep
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine xname (lxname,ixname)
c
      character*(*) lxname
c
c
      idol=index(lxname,'$')
      if(idol.eq.0) idol=ixname
        write (7,2) 'xname '
    2    format (a6)
        write (7,900) lxname(1:idol)
  900   format (a)
        write (7,*) ixname
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine xticks (iticks)
c
c
        write (7,2) 'xticks'
    2    format (a6)
        write (7,*) iticks
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine x3dm0 ( x, nr )
c
c
      dimension  x(nr)
c
      write (7,2) 'x3dm0 '
    2 format ( a6 ) 
      write (7,*) nr
c
      write (7,10) ( x(i), i=1,nr )
   10 format (1p8e10.3)
c
      return
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine x3name (lxname,ixname) 
c
      character*(*) lxname
c
c
      idol=index(lxname,'$')
      if(idol.eq.0) idol=ixname
        write (7,2) 'x3name'
    2    format (a6)
        write (7,900) lxname(1:idol)
  900   format (a)
        write (7,*) ixname
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine yaxang (ang) 
c
c
        write (7,2) 'yaxang'
    2    format (a6)
        write (7,*) ang
c
      return
c
      end 
c
c
c-------------------------------------------------------------------
c
c
      subroutine yintax
c
c
        write (7,2) 'yintax'
    2    format (a6)
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine ylgplt (xaray,yaray,npnts)
c
      dimension xaray(npnts),yaray(npnts)
c
c
        write (7,2) 'ylgplt'
    2    format (a6)
        write (7,*) npnts
        do 1000 i=1,npnts
         write (7,*) xaray(i),yaray(i)
 1000   continue
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine ylog (xorig,xstep,yorig,ycycl)
c
c
        write (7,2) 'ylog  '
    2    format (a6)
        write (7,*) xorig,xstep,yorig,ycycl
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine yname (lyname,iyname)
c
      character*(*) lyname
c
      idol=index(lyname,'$')
      if(idol.eq.0) idol=iyname
        write (7,2) 'yname '
    2    format (a6)
        write (7,1100) lyname(1:idol)
 1100   format (a)
        write (7,*) iyname
c
      return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine yticks (iticks)
c
c
        write (7,2) 'yticks'
    2    format (a6)
        write (7,*) iticks
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine y3dm0 ( y, nc )
c
c
      dimension  y(nc)
c
      write (7,2) 'y3dm0 '
    2 format ( a6 ) 
      write (7,*) nc
c
      write (7,10) ( y(j), j=1,nc )
   10 format (1p8e10.3)
c
      return
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine y3name (lyname,iyname) 
c
      character*(*) lyname
c
      idol=index(lyname,'$')
      if(idol.eq.0) idol=iyname
        write (7,2) 'y3name'
    2    format (a6)
        write (7,1100) lyname(1:idol)
 1100   format (a)
        write (7,*) iyname
c
      return
c
      end 
c
c
c-----------------------------------------------------------------
c
c
      subroutine zintax
c
c
        write (7,2) 'zintax'
    2    format (a6)
c
        return
c
      end 
c
c
c-------------------------------------------------------------------- 
c
c
      subroutine zeta
c
      common /hwblk/ hws
      logical hws
c
      character*25  plfile
c
  10  print *, ' Type in name for plot file '
      print *, '   (25 characters or less) '
c----      read (*, *, err = 10) plfile
c
      plfile = 'plfile'
      print *, ' File name set to "plfile" in ZETA (in dsp205.f) '
c
      hws=.false.
c
c
        open ( 7 , file = plfile )
c
c
        write (7,2) 'zeta  '
    2    format (a6)
      call menu
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine z3name (lzname,izname) 
c
      character*(*) lzname
c
      idol=index(lzname,'$')
      if(idol.eq.0) idol=izname
        write (7,2) 'z3name'
    2    format (a6)
        write (7,1100) lzname(1:idol)
 1100   format (a)
        write (7,*) izname
c
      return
c
      end 
c
c
c---------------------------------------------------------------------
c
c
      subroutine menu
c
c
      integer  dvals,type,pensize,colorpn
c
 1    print *,'*** the default values for plotting are:'
      print *,' black, ball point pen & 12 in. paper.  enter 1 if you'
      print *,' wish to use these values, otherwise enter 0'
      read *,dvals
c
c ***   set up the default values
c
      if(dvals.ne.1.and.dvals.ne.0) goto 1
      write(7,*)dvals
      if(dvals.eq.1) goto 110 
c
c ***   start printing the menu
c
 27   print *,'enter the size of paper you wish to use:'
      print *,' '
      print *,'1. 12 inch'
      print *,'2. 36 inch'
      print *,' '
      print *,'(enter either 1 or 2)'
      print *,' '
      read *,ipaper 
      if(ipaper.lt.1.or.ipaper.gt.2) goto 27
      write(7,*) ipaper
 3    print *,'enter the number of colors you'
      print *,' wish to use (i.e. 1,2,3,4):'
      read *,num
      if(num.lt.1.or.num.gt.4) goto 3
      write(7,*) num
      print *,' '
 2    continue
c
c ***   this loops thru the menu depending on how many colors
c        were specified.
c
      do 101 i=1,num
 5    print *,'please enter the type of pen you wish to use :'
      print *,' '
      print *,'1.  ball point'
      print *,'2.  nylon'
      print *,'3.  liquid ink'
      print *,' '
      print *,'(enter a number only)'
      print *,' '
      read *,type
      if(type.ne.1.and.type.ne.2.and.type.ne.3) goto 5
      write(7,*) type
      print *,' '
      if(type.eq.3) then
 7      print *,'please enter the size of pen you wish to use:'
        print *,'1. 00'
        print *,'2. 0'
        print *,'3. 1'
        print *,'4. 2'
        print *,'5. 3'
        print *,'6. 4'
        print *,' ' 
        print *,'(enter a number only)' 
        print *,' ' 
        read *,pensize
        if(pensize.lt.1.or.pensize.gt.6) goto 7
      write(7,*) pensize
      endif
 9    print *,'please enter the color of pen you wish to use:'
      print *,' '
      print *,'1. black'
      print *,'2. red'
      print *,'3. green'
      print *,'4. blue'
      print *,' '
      print *,'(enter a number only)'
      print *,' '
      read *,colorpn
      if(colorpn.lt.1.or.colorpn.gt.4) goto 9
      write(7,*) colorpn
c
 101  continue
110   continue
 23   format(a40)
      return
      end 
