cc     t.f
c
cc     Plot multiple polylines.
c
c      character*1 ans
c      real x(2), y(2)
c      integer ired(256), igrn(256), iblu(256)
c
cc.....Open plot.
c      call openplot ()
c
cc.....Set color map.
c       print *, ' Give ncolors (try 16 and 17, for example): '
c       read *, ncolors
c        ired(1) = 255
c        igrn(1) = 255
c        iblu(1) = 255
c      do 10 i=2,ncolors
c        ired(i) = 0
c        igrn(i) = 0
c        iblu(i) = 0
c 10   continue
c      call setclrmap (ncolors, ired,igrn,iblu)
c
cc.....Plot  polyline.
c      do 20 i=1,40
c        print *, '  Plotting polyline = ', i
c        x(1) = 1.0 + i*0.1
c        y(1) = 1.0
c        x(2) = x(1)
c        y(2) = y(1) + 1.0
c        npts = 2
c        call gpl (npts,x,y)
c 20   continue
c
cc.....Finish plotting.
c      print *, '  Hit CR to end...'
c      read '(a)', ans
c      call closeplot ()
c
c      stop
c      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine bell

c     Rings the terminal bell.

      character bel*1
      parameter (bel=char(7))

        write(6,*) bel

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine closeplot 

c     Ends gks.  

      character saveans*2
      common /saveans0/ saveans

c.....Workstation identifiers.
      parameter (iwkx11=1, iwkmo=2, iwkwiss=3)

c.....Close the X11 workstation.
      if (saveans.eq.'p' .or. saveans.eq.'ps')  call closewk(iwkx11)

c.....Close the meta-workstation.
      if (saveans.eq.'s' .or. saveans.eq.'ps')  call closewk(iwkmo)

c.....Close the WISS workstation.
      call closewk(iwkwiss)

c.....Close GKS.
      call gclks

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine closewk (iwk)

c     Closes workstation and ends gks.  

c     Deactivate workstation.
      call gdawk (iwk)

c     Close workstation.
      call gclwk (iwk)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine errmsg (msg)
c     Prints an error message and rings bell.

      character msg*(*), mess*80

      mess = msg
      lenm = lentrue (mess)

      call bell
      call pl ('*** ERROR - '//mess(1:lenm))

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine fnroot (fname, root)
c     Returns the first part (before .) of a filename.

      character fname*(*), root*(*)
      character temp*80

      root = ' '
      temp = fname
        lenf = lentrue (temp)

      ibeg = 1
      do 50 i = lenf,1,-1
        if (temp(i:i).eq.'/' .or.
     &      temp(i:i).eq.']') then
          ibeg = i + 1
          goto 60
        endif
 50   continue

 60   temp = temp (ibeg:)
        lenf = lentrue (temp)

      iend = lenf
      inddot = index (temp, '.')
        if (inddot.gt.1)  iend = inddot - 1

      root = temp (1:iend)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine getfile2 (unit,quest,inout,form,suffix)

c       Opens files...filenames not recognized will generate
c     an error message and request a second try.
c       Giving a  blank filename or CR will cause the default filename
c     appearing in square brackets to be used, unless the default is
c     itself blank.
c       The default filename is constructed from suffix in the
c     following way.  If suffix starts with a '.' a filename root
c     is searched for in a file called 'savefn.tmp' and the new suffix
c     is appended.  If suffix does not start with a '.', it is assumed
c     to be the complete filename.

c      Variables:
c        unit     = io unit (Must be a variable if 'none' option is used.)
c        quest = query requesting file name
c        inout    = 'in' or 'out'
c        form     = 'unformatted' (binary) or
c                   'formatted' (ascii with no carriage control) or
c                   'fortran' (ascii with fortran carriage control).
c        suffix   = '.dat' for example or a complete file name

c      Sample call:
c           call getfile(21,' Give input file','in','formatted','.dat')

      external lentrue
      integer unit
      character*(*) quest, inout, form, suffix
      character fname*80, dfname*80, temp*80
      character root*50, suff*50

      common/savefn/ fname

      suff = suffix
      call ljust(suff)
      call uc2lc(suff)
      lensuf = lentrue (suff)

c     Suffix does not begin with '.' ... must be a complete filename...
      if(lensuf.ne.0 .and. suff(1:1).ne.'.') then
        dfname=suff

c     Read filename from save-file and add suffix if not blank...
      else
        call getfn (dfname)
        if (lensuf.ne.0) then
          call fnroot (dfname, root)
            lenrt = lentrue (root)
            if (lenrt.eq.0) root = '?'
          call makefn (root, suff, dfname)
        endif
      endif

 10   leng=lentrue(dfname)

c     Ask for file, giving default filename in [] if there is one.
c      call pl(' ')
      if(leng.ge.1) then
c        call uc2lc (dfname)
        call prquesd (quest, dfname)
      else
        call prques (quest)
      endif

      call rdans (fname)
      call ljust(fname)
      lenf = lentrue(fname)
      if (fname.eq.'none' .or. fname.eq.'n') then
c       File is not wanted.
        suffix = 'none'
        unit = 0
        return
      endif

      if(fname.eq.' ') then
        fname = dfname

      else if(fname.ne.' ') then
        idot = index(fname,'.')
        idotd= index(dfname,'.')
        if (idotd.eq.0) then
           lendef = lentrue (dfname)
        else
           lendef = idotd - 1
        endif
        if(idot.eq.0) then
c         Only a new root is given.  Fix default and query again...
          if(idotd.ne.0) then
             temp = fname(1:lenf)//dfname(idotd:leng)
             dfname = temp
          else
             dfname=fname(1:lenf)
          endif
          fname = ' '
        else if(idot.eq.1) then
c         Only a new suffix is given.  Fix default and query again...
          temp = dfname(1:lendef)//fname(idot:lenf)
          dfname = temp
          fname = ' '
        else
c         Decent new filename is probably given so continue ...
        endif
      endif

c     Repeat query if filename is still blank...
      if(fname.eq.' ') goto 10

c     Save the new filename unless a full filename was given in suffix.
      if(lensuf.ne.0 .and. suff(1:1).ne.'.') then
          continue
      else
          call putfn (fname)
      endif

c     filename is in hand, so open file...
      call opfile (unit, fname, inout, form, *900)

      return

c.....Error message for bad open...
 900  call bell
      call pl (' ** Error in opening  '//
     &         fname(1:lentrue(fname))//' .... Try again.')
      go to 10

      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine getfn (fname)
c     Returns the filename in a save file.

      character fname*(*)
      character savefn*80
      parameter (savefn='savefn.tmp')

      fname = ' '

      open(91,file=savefn,form='formatted',status='old',iostat=ios)
        if (ios.ne.0) return
      read(91,'(a)',iostat=ios) fname
      close(91)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine getfn2 (savefn, fname)
c     Returns the filename in a save file.

      character fname*(*)
      character savefn*(*)

      fname = ' '

      open(91,file=savefn,form='formatted',status='old',iostat=ios)
        if (ios.ne.0) return
      read(91,'(a)',iostat=ios) fname
      close(91)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine getmetafn (fname)
c     Returns the next sequential junk filename.

      character fname*(*)
      character savefn*80
      parameter (savefn='metafn.tmp')

      fname = ' '

      call getfn2 (savefn, fname)

      if (fname.eq.' ') then
        fname = 'meta1'
      else
        read (fname(5:), *) num
        num = num+1
        write (fname,'(a4,i5)') 'meta', num
        call rmblanks (fname, fname, len2)
      endif

      call putfn2 (savefn, fname)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine getopt (query,options,default,answer)
c     Queries user for option desired--returns lower case answer.
c       query = query.
c       options = character string with options separated by /.
c       default = default option to be used if a CR is the answer.
c       answer = option selected (or default).
c
c     Sample call:
c
c       call getopt('Want tic marks?','y/n','n',answer)
c

      character*(*) query, options, default, answer
      character*256 ques, opts, def
      character ans*10, test*12

      lengq=lentrue(query)
      lengo=lentrue(options)
      lengd=lentrue(default)

c     Add slashes to front and back of option string to aid searches.
      opts = '/'//options(1:lengo)//'/'
       call uc2lc(opts)
      def = default
       call uc2lc(def)

 10   ques = query(1:lengq)//' ('//options(1:lengo)//')'
      call prquesd (ques, default)

      call rdans (ans)
       call ljust(ans)
       lenga=lentrue(ans)
       if (lenga .ne. 0) then
         test = '/'//ans(1:lenga)//'/'
           call uc2lc(test)
         lent = lentrue (test)
       endif

      if(lenga.eq.0) then
        answer = default
      else if(index(opts, test(1:lent)) .eq. 0) then
        call errmsg ('not an option...try again.')
        goto 10
      else
        answer = ans
      endif

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      integer function leftend (string)
c     Gives position of first non-blank, non-tab, non-null
c     character in string.  Returns 0 if no such beast in string.

      character*(*) string
      character*1 blank, tab, null
      parameter (blank=' ', tab=char(9), null=char(0))

      leftend=0

      do 100 i=1,len(string)
        if(string(i:i).ne.blank .and.
     &     string(i:i).ne.tab   .and.
     &     string(i:i).ne.null) then
            leftend=i
            return
        endif
 100  continue

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      integer function lentrue (string)
c     Gives position of last non-blank, non-tab, non-null character 
c     in a string.  Returns 0 if no such beast exists in the string.

      character*(*) string
      character*1 blank, tab, null
      parameter (blank=' ', tab=char(9), null=char(0))

      lentrue=0

      do 100 i=len(string),1,-1
        if (       string(i:i).ne.blank
     &       .and. string(i:i).ne.tab
     &       .and. string(i:i).ne.null) then
          lentrue=i
          return
        endif
 100  continue

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine ljust (string)
c     Left justifies a string by eliminating blanks, tabs, nulls
c     at left end of string.

      character*(*) string
      external leftend

      ifirst=leftend(string)
      if(ifirst.le.1) then
        return
      else
        l2=len(string)-(ifirst-1)
        string(1:l2)=string(ifirst:ifirst+l2-1)
        string(l2+1:len(string))=' '
      endif

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine makefn (root, suff, fname)
c       Joins given root and suffix to make a filename.

      character*(*) root, suff, fname

      lenr = lentrue (root)

      if (suff(1:1).ne.'.') then
        fname = root(1:lenr)//'.'//suff
      else
        fname = root(1:lenr)//suff
      endif

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine openplot () 

c     Open the GKS plot package.
c     Opens X11 workstation (iwk=#1) and/or metafile (iwk=#2) for plotting.
c     Sets transformation #1 from Plot-Board (PB) WCs (inches) to NDCs.

      character saveans*2, metaroot*100
      common /saveans0/ saveans

      common /xllwindow0/  x11l,x11r,x11b,x11t
      real ndcl,ndcr,ndcb,ndct 
      common /ndcwindow0/ ndcl,ndcr,ndcb,ndct
      common /pbwindow0/ pbl,pbr,pbb,pbt

c.....Workstation identifiers.
      parameter (iwkx11=1, iwkmo=2, iwkwiss=3)

c.....Workstation types.
      parameter (imi=1, imo=2, iwiss=3, ix11=4)

c.....Workstation connections to iounits.
      parameter (imocon=95, ix11con=0)

c.....Save plot instructions in a metafile?
      call getopt (
     &  ' >Plot, Save, or Plot-and-Save?','p/s/ps','p', saveans)
      if (saveans.eq.'s' .or. saveans.eq.'ps') then
c       Open file to save plot instructions.
        call getmetafn (metaroot)
        lenr = lentrue (metaroot)
        call getfile2
     &     (imocon,' >Save file','out','formatted',
     &      metaroot(1:lenr)//'.gks')
      endif

c.....Open GKS.
      ierror = 0
      imemory = 0
      call gopks (ierror,imemory)

c.....Open and activate X11 workstation.
      if (saveans.eq.'p' .or. saveans.eq.'ps') then
c       Open workstation
          call gopwk (iwkx11,ix11con,ix11)
c       Activate workstation.
          call gacwk (iwkx11)
c       Inquire window size.
          call gqdsp (ix11, ind, iunits, rx, ry, ix, iy)
c          print *, ' ind =', ind
c          print *, ' iunits =', iunits
c          print *, ' rx,ry =', rx,ry
c          print *, ' ix,iy =', ix,iy
c       Figure height/width ratio.
          if (rx.ne.0.0) then
            hwratio = ry/rx
          else
            hwratio = 1.0
          endif
c       Set  X11 gks-window shape ratios.
          x11l = 0.0
          x11r = 1.0
          x11b = 0.0
          x11t = hwratio
c       Make whole X11 gks-window the workstation window.
          call gswkwn (iwkx11, x11l,x11r,x11b,x11t)
      endif

c.....Open and activate metafile "workstation".
      if (saveans.eq.'s' .or. saveans.eq.'ps') then
c       Open meta-workstation
          call gopwk (iwkmo,imocon,imo)
c       Activate meta-workstation.
          call gacwk (iwkmo)
c       Make whole X11 gks-window the workstation window.
          if (saveans.eq.'s') then
            x11l = 0.0
            x11r = 1.0
            x11b = 0.0
            x11t = 0.8
          endif
          call gswkwn (iwkmo, x11l,x11r,x11b,x11t)
      endif

c.....Open and activate WISS "workstation".
c       Open wiss-workstation
          call gopwk (iwkwiss,0,iwiss)
c       Activate wiss-workstation.
          call gacwk (iwkwiss)

c.....Define Normalized Device Coordinate window size from X11 window shape.
      ndcl = x11l
      ndcr = x11r
      ndcb = x11b
      ndct = x11t

c.....Define a Plot-Board-World-Coord (PBWC) system in inches 
c      with bounds based on NDC window shape.
c       (WCs will be xmult times larger than NDC's)
      xmult = 10.0
      pbl = xmult * ndcl
      pbr = xmult * ndcr
      pbb = xmult * ndcb
      pbt = xmult * ndct

c.....Set initial transformation (#1) from PBWCs to NDCs.
c      (PlotBoard inches will map to NDCs.)
      itr = 1
      call gswn (itr, pbl, pbr, pbb, pbt)
      call gsvp (itr, ndcl,ndcr,ndcb,ndct)
      call gselnt (itr)
c     Set mapping...
      call setpb2ndc (pbl,pbr,pbb,pbt,
     &                   ndcl,ndcr,ndcb,ndct)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine opfile (unit, fname, inout, form, *)

c     Opens files.  Goes to alternate return on error.

      integer unit
      character*(*) fname, inout, form
      character status*8

c     For INPUT, open the file with appropriate attributes...
      if(inout(1:2).eq.'in') then
        status='old'
        open(unit,file=fname,form=form,status=status,err=900)

c     For OUTPUT, open the file with appropriate attributes...
      else if(inout(1:3).eq.'out') then
        status='new'
        if(form.eq.'formatted') then
          open(unit,file=fname,form=form,status=status,err=900)
        else if(form.eq.'fortran') then
          open(unit,file=fname,form='formatted',status=status,err=900)
        else if(form.eq.'unformatted') then
          open(unit,file=fname,form=form,status=status,err=900)
        endif

      else
        write(6,*) ' ERROR... variable in sub OPFILE not recognized.'
        write(6,*) '  inout = ', inout
        stop

      endif

      return

c.....Alternate return for bad open.
c 900  call pl(' ****  ERROR opening file ....')
 900  return1

      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine pl (line)
c     Prints line of text and one CR.
c     Uses UNIX io sub PUTC.

      character line*(*)
      common /terminal/ iterm
      iterm = 6

c     Find length of line
      lenl = lentrue (line)

c     Print the line
      do 10 i=1,lenl
c        call putc (line(i:i))
        call fputc (iterm, line(i:i))
 10   continue

c     Print newline
c      call putc ('\n')
      call fputc (iterm, '\n')

      return
      end



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine pq (ques)
c     Prints question and several blanks with no CR.
c     Uses UNIX io sub PUTC.

      character ques*(*), blank*1
      parameter (blank = ' ')
      common /terminal/ iterm
      iterm = 6

      lenq = lentrue (ques)

c     Print the question
      do 10 i=1,lenq
c        call putc (ques(i:i))
        call fputc (iterm, ques(i:i))
 10   continue

c     Print additional blank spaces
      do 20 i=1,2
c        call putc (blank)
        call fputc (iterm, blank)
 20   continue

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine prques (query)
c     Prints a query in a 'standard' format.

      character query*(*), ques*80, temp*80

      ques = query
c      call lc2uc (ques)
      lenq = lentrue (ques)

      temp = ques(1:lenq)//':  '
      ques = temp
      lenq = lenq + 3

      call pq (ques)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine prquesd (query, default)
c     Prints a query in a 'standard' format with a default answer
c       in brackets (that is later to be activated by a CR response).

      character query*(*), ques*100, temp*100
      character default*(*), def*100

      ques = query
c        call lc2uc (ques)
        lenq = lentrue (ques)
      def = default
        lend = lentrue (def)

      if (lend .ne. 0) then
        temp = ques(1:lenq)//':  ['//def(1:lend)//']  '
        ques = temp
        lenq = lenq + 4 + lend + 3
      else if (lend .eq. 0) then
        temp = ques(1:lenq)//':  '
        ques = temp
        lenq = lenq + 3
      endif

      call pq (ques)

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine putfn (fname)
c     Stores a filename in a file savefn.TMP for future reference.

      character fname*(*), savefn*80
      parameter (savefn='savefn.tmp')

      open(91,file=savefn,form='formatted',status='unknown',err=90)
      write(91,'(a)',err=90) fname (1:lentrue(fname))
      close(91)

 90   return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine putfn2 (savefn, fname)
c     Stores a filename in a file savefn.TMP for future reference.

      character fname*(*), savefn*(*)

      open(91,file=savefn,form='formatted',status='unknown',err=90)
      write(91,'(a)',err=90) fname (1:lentrue(fname))
      close(91)

 90   return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine rdans (string)
c     Reads an answer string. Deletes all parts of a string
c       after an ! (=comment).  If string starts with ! will
c         go and get the next string.

      character string*(*), str*132

 10   read '(a)', str

c.....Delete part of string after !.
      indexc = index(str, '!')
      if (indexc .eq. 0) then
        string = str
      else if (indexc .eq. 1) then
        goto 10
      else if (indexc .ge. 2) then
        lens = indexc - 1
        string = str (1:lens)
      endif

c.....Change a string consisting of a comma (alternate default answer) to a blank.
      str = string
      call ljust(str)
      lens = lentrue(str)
      if (lens.eq.1 .and. str(1:1).eq.',')  string = ' '

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine rmblanks (str1,str2,len2)
c     Removes all blanks from str1, returns result as str2.

      character*(*) str1,str2
      external lentrue

      len1 = lentrue(str1)
      len2 = len(str2)

      j=0

      do 50 i=1,len1
        if(str1(i:i).ne.' ') then
         j=j+1
         str2(j:j)=str1(i:i)
        endif
 50   continue

      do 60 i = j+1, len2
        str2(i:i) = ' '
 60   continue

      len2=j

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine setclrmap (ncolors, red, grn, blu)

c     Set color representation.
c       (Initializes color table using ncolors.)

      real r, g, b

      parameter (NCMAX=256)
      integer red(NCMAX), grn(NCMAX), blu(NCMAX)
      integer red0(NCMAX), grn0(NCMAX), blu0(NCMAX)

      common /clrmap0/ red0, grn0, blu0

      character saveans*2
      common /saveans0/ saveans

c.....Workstation identifiers.
      parameter (iwkx11=1, iwkmo=2, iwkwiss=3)

c.....Check number of colors.
      if (ncolors.gt.NCMAX) then
        print *, ' *** ERROR, ncolors > 256 in subroutine setclrmap...'
        stop
      endif

c.....Save colors in common block.
      do 5 i = 1,ncolors
        red0(i) = red(i)
        grn0(i) = grn(i)
        blu0(i) = blu(i)
 5    continue

c.....Set color map.
      do 10 i = 1,ncolors
        r = real(red(i)/255.0)
        g = real(grn(i)/255.0)
        b = real(blu(i)/255.0)
        if (saveans.eq.'p' .or. saveans.eq.'ps') then
          call gscr (iwkx11, i-1, r,g,b)
        endif
        if (saveans.eq.'s' .or. saveans.eq.'ps') then
          call gscr (iwkmo, i-1, r,g,b)
        endif
 10   continue

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine setpb2ndc 
     &    (xpbmn,xpbmx,ypbmn,ypbmx, xndcmn,xndcmx,yndcmn,yndcmx)

c       Sets transformation for changes of coordinates from plot-board
c     window (often in inches) to NDC viewport and back again.

      common/pb2ndcinfo/ 
     &      xpb2ndcfactor, ypb2ndcfactor, xndc2pbfactor, yndc2pbfactor,
     &      xpb2ndcadd, ypb2ndcadd, xndc2pbadd, yndc2pbadd

c.....Check that plot-boaard window does not have trivial dimensions.
      if((xpbmx-xpbmn .eq. 0.0) .or. (ypbmx-ypbmn .eq. 0.0)) then
          call pl (
     &     ' **** Error - plot-board-window area is 0 in sub setpb2ndc')
          print *, xpbmn,xpbmx,ypbmn,ypbmx
          stop
      endif

c.....Check that NDC viewport does not have trivial dimensions.
      if((xndcmx-xndcmn .eq. 0.0) .or. (yndcmx-yndcmn .eq. 0.0)) then
          call pl (' **** Error - viewport area is 0 in sub setpb2ndc')
          stop
      endif

c.....Calculate transform parameters.
      xpb2ndcfactor = (xndcmx-xndcmn) / (xpbmx-xpbmn)
      ypb2ndcfactor = (yndcmx-yndcmn) / (ypbmx-ypbmn)
      xndc2pbfactor = 1.0 / xpb2ndcfactor
      yndc2pbfactor = 1.0 / ypb2ndcfactor

      xndc2pbadd = xpbmn - xndcmn * xndc2pbfactor
      yndc2pbadd = ypbmn - yndcmn * yndc2pbfactor
      xpb2ndcadd = xndcmn - xpbmn * xpb2ndcfactor
      ypb2ndcadd = yndcmn - ypbmn * ypb2ndcfactor

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine pb2ndc (xd,yd,xndc,yndc)

c     Scales plot-board coordinates (often in inches) to NDC coordinates.
c     Must be set by calling subroutine setpb2ndc.

      common/pb2ndcinfo/ 
     &      xpb2ndcfactor, ypb2ndcfactor, xndc2pbfactor, yndc2pbfactor,
     &      xpb2ndcadd, ypb2ndcadd, xndc2pbadd, yndc2pbadd

      xndc = xd * xpb2ndcfactor + xpb2ndcadd
      yndc = yd * ypb2ndcfactor + ypb2ndcadd

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine ndc2pb (xndc,yndc,xd,yd)

c     Scales NDC coordinates to plotboard coordinates (often in inches).
c     Scaling factors are set by calling subroutine setpb2ndc.

      common/pb2ndcinfo/ 
     &      xpb2ndcfactor, ypb2ndcfactor, xndc2pbfactor, yndc2pbfactor,
     &      xpb2ndcadd, ypb2ndcadd, xndc2pbadd, yndc2pbadd

      xd = xndc * xndc2pbfactor + xndc2pbadd
      yd = yndc * yndc2pbfactor + yndc2pbadd

      return
      end


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine uc2lc (string)
c     Converts upper case letters to lower case...
c     Assumes that the codes are in sequence for a-z and A-Z

      character string*(*), s*1

      lstr=len(string)

      do 20 i=1,lstr
        s=string(i:i)
        if(s.ge.'A'. and .s.le.'Z') then
         string(i:i)=char(ichar(s)-ichar('A')+ichar('a'))
        endif
 20   continue

      return
      end
