subroutine axis (x,y,string,ns,size,angle,zmin,zdel,lrot,iform)
c
c Routine to center everything in sight nicely and plot a coordinate
c axis.
c
c James Blake
c @(#)axis.f	1.6  12/1/89 
c
      dimension ww(2)
      character*40 numstring
      character*(*) string
      include 'device_type.h'
      data ww / -0.1,+0.1 /
c
c     initialization
c
      c = cosd(angle)
      s = sind(angle)
c
      nchar = iabs(ns)
      if (ns .lt. 0) then
         l = 1
      else
         l = 2
      endif
      n = size+.99
c
c     plot axis and tic marks
c
      xb = x+n*c
      yb = y+n*s
c
c At present, two axis styles are supported.  Tick
c marks above and below the axes.
c
      if(lrot .gt. 0) ww(l) = -ww(l)
      xa = xb-ww(l)*s
      ya = yb+ww(l)*c
      call plot (xa,ya,3)
      do 20 i = 1, n
         call plot (xb,yb,2)
         xb = xb-c
         yb = yb-s
         call plot (xb,yb,2)
         xa = xa-c
         ya = ya-s
         call plot (xa,ya,2)
   20 continue
c
c     plot number annotation along axis
c
      if (s .gt. c) then
         if (lrot .gt. 0) xa = xa - 0.1
         xa = xa - 0.075
         ya = ya - 0.075
      else
         if (lrot .gt. 0) ya = ya - 0.15
         ya = ya - 0.275
      endif
      za = zmin
      do 10 i = 0, n
         call num_to_string(za,iform,numstring)
         if (s .gt. c) then
            call right_justify(xa,ya,0.15,numstring)
         else
            call center(xa,ya,0.15,numstring,0.0)
         endif
         xa = xa+c
         ya = ya+s
         za = za+zdel
   10 continue
c
c     plot identification label along axis if desired
c
      if (nchar .eq. 0) return
c
      if (s .gt. c) then
         xa = x - 1.15
         ya = y + size / 2.0
         call center(xa,ya,0.15,string,angle)
      else
         xa = x + size / 2.0
         ya = ya - 0.35
         call center(xa,ya,0.15,string,0.0)
      endif
      return
      end
c
c
      real function str_wid(string,h,angle)
c
c James Blake
c 11/21/88
c
      character*(*) string
      integer llx,lly,ulx,uly,urx,ury
      include 'device_type.h'
c
      if (color_ws .or. mono_ws) then
         call limits(string,ib,ie)
         if (angle .eq. 0.0) call set_char(h,angle)
         call cfqtextext(string(ib:ie),' ',iconx,icony,
     &                   llx,lly,ulx,uly,urx,ury)
         str_wid = abs(page_x(urx) - page_x(llx))
      endif
      return
      end
c
c
c
      subroutine num_to_string (xnum,ijk,iwk)
c
c     use the format to encode a number.
c
c James Blake
c 11/21/88
c
c
      character*(*) iwk
c
      character*6 iform(18)
      data iform / '(f6.4)','(f6.3)','(f6.2)','(f6.1)','(f6.0)','(f5.3)'
     *   ,'(f5.2)','(f5.1)','(f5.0)','(f4.2)','(f4.1)','(f3.1)','(i6)  '
     *   ,'(i5)  ','(i4)  ','(i3)  ','(i2)  ','(i1)  '/
c
      do 10 k = 1, len(iwk) 
         iwk(k:k) = ' '
 10   continue
c
c Encode and integer or real ?
c
      if (ijk.le.12) then
c
c     encode a real number
c
         write (iwk,iform(ijk)) xnum
      else
c
c     encode an integer number
c
         num = int(xnum)
         write (iwk,iform(ijk)) num
      endif
      call limits(iwk,ibegin,iend)
      return
      end
c
      subroutine right_justify(x,y,h,string)
c
c James Blake
c 11/21/88
c
      character*(*) string
      character*(80) subwidth
      include 'device_type.h'
      common /tscale/ sfactt
      common /cqpbnf/ xold, yold, fac, ires
c
c font fudge factor to get proper heigh
c
      save  cfudge
      data  cfudge /1.66666666/
c
      call limits(string,ibeg,iend)
      length = iend - ibeg + 1
      if (color_ws .or. mono_ws) then
         ix = int(3276.7*(h*sfactt))
         call cfcharheight(ix)
         delta = str_wid(string,h,0.0)
         call symbol (x-delta,y,h,string(ibeg:iend),
     &                0.0,length)
      elseif (PostScript) then
C
C   Initialize 
C
         call plot (x, y, 3)
C
C   Round angle to integer - good to 1 degree
C
         cosang = cosd(float(0))
         sinang = sind(float(0))
C
C   Set char heigh
C
         call pliout (nint (h * cfudge * fac * ires))
         call plsout (" H ")
C
C   Plot a string of characters
C
         if (length .le. 0) return
C
C     Output "(string) S ", escape ( ) \
C
         call plcout(char(40))
         j = ibeg - 1
         item = 0
C
C Get rid of Prefixed symbols
C
         do i = ibeg, iend 
           ic = mod(ichar(string(i:i)), 127)
           if (ic .eq. 92 .or. ic .eq. 94 .or. ic .eq. 95) then
              item = item + 1
           endif
         enddo
         k = 0
         do 20 i = ibeg, iend - item
            j = j + 1
            ic = mod(ichar(string(j:j)), 127)
C
C encode the ( and ) symbols
C
            if    (ic .eq. 40) then
               call plsout ("\\050")
            else if   (ic .eq. 41) then
               call plsout ("\\051")
C
C Encode the angstrom symbol
C
            else if(ic .eq. 92) then
               j = j + 1
               icn = mod(ichar(string(j:j)), 127)
               if (icn .eq. 65) call plsout("\\201")
C
C Deal with the smaller sub/super scripts
C
            elseif(ic .eq. 94 .or. ic .eq. 95) then
               j = j + 1
               k = k + 1
               icn = mod(ichar(string(j:j)), 127)
               subwidth(k:k) = char(icn)
            else
               call plcout(char(ic))
            endif
20       continue
         call plsout(") stringwidth pop neg 0 rmoveto\n")
C
C If there were any sub... figure out how they effect the
C positions.
C
         if (k .ne. 0) then
            call pliout (nint (h * cfudge * fac * ires * 0.8))
            call plsout (" H ")
            call plcout(char(40))
            do i = 1, k
               call plcout(subwidth(i:i))
            enddo
            call plsout(") stringwidth pop neg 0 rmoveto\n")
         endif
C
C Process the string for writing.
C
         nch = iend - ibeg + 1
         call spec_str(h,string(ibeg:iend),nch)
C
C       Update our idea of where the pen is.
C
         xold = x + (nch * h * fac * cosang)
         yold = y + (nch * h * fac * sinang)
         call plcout (char(10))
      endif
      return
      end
c
c
      subroutine center(x,y,h,string,angle)
c
c James Blake
c 11/21/88
c
      character*(*) string
      character*(80) subwidth
      include 'device_type.h'
      common /tscale/ sfactt
      common /cqpbnf/ xold, yold, fac, ires
      save   /cqpbnf/
c
c font fudge factor to get proper heigh
c
      save  cfudge
      data  cfudge /1.66666666/
c
      call limits(string,ibeg,iend)
      length = iend - ibeg + 1
      if (color_ws .or. mono_ws) then
         ix = int(3276.7*(h*sfactt))
         call cfcharheight(ix)
         delta = str_wid(string,h,angle) / 2.0
         if (nint(angle) .ne. 0) then
            call symbol (x,y-delta,h,string(ibeg:iend),
     &                   angle,length)
         else
            call symbol (x-delta,y,h,string(ibeg:iend),
     &                   angle,length)
         endif
      elseif (PostScript) then
C
C   Initialize 
C
         call plot (x, y, 3)
C
C   Round angle to integer - good to 1 degree
C
         cosang = cosd(float(0))
         sinang = sind(float(0))
C
C   Set char height
C
         call pliout (nint (h * cfudge * fac * ires))
         call plsout (" H ")
C
C   Plot a string of characters
C
         if (length .le. 0) return
         if (nint(angle) .ne. 0) then
            call pliout (nint(angle))
            call plsout (" RS ")
         endif
C
C     Output "(string) S ", escape ( ) \
C
         call plcout(char(40))
         j = ibeg - 1
         item = 0
C 
C Get rid of Prefixed symbols 
C
         do i = ibeg, iend 
           ic = mod(ichar(string(i:i)), 127)
           if (ic .eq. 92 .or. ic .eq. 94 .or. ic .eq. 95) then
              item = item + 1
           endif
         enddo
         k = 0
         do 20 i = ibeg, iend - item
            j = j + 1
            ic = mod(ichar(string(j:j)), 127)
C
C encode the ( and ) symbols
C
            if    (ic .eq. 40) then
               call plsout ("\\050")
            else if   (ic .eq. 41) then
               call plsout ("\\051")
C
C Encode the angstrom symbol
C
            else if(ic .eq. 92) then
               j = j + 1
               icn = mod(ichar(string(j:j)), 127)
               if (icn .eq. 65) call plsout("\\201")
C
C Deal with the smaller sub/super scripts
C
            elseif(ic .eq. 94 .or. ic .eq. 95) then
               j = j + 1
               k = k + 1
               icn = mod(ichar(string(j:j)), 127)
               subwidth(k:k) = char(icn)
            else
               call plcout(char(ic))
            endif
20       continue
         call plsout(") stringwidth pop 2 div neg 0 rmoveto\n")
C
C If there were any sub... figure out how they effect the
C positions.
C
         if (k .ne. 0) then
            call pliout (nint (h * cfudge * fac * ires * 0.8))
            call plsout (" H ")
            call plcout(char(40))
            do i = 1, k
               call plcout(subwidth(i:i))
            enddo
            call plsout(") stringwidth pop 2 div neg 0 rmoveto\n")
         endif
C
C Process the string for writing.
C
         nch = iend - ibeg + 1
         call spec_str(h,string(ibeg:iend),nch)
         if (nint(angle) .ne. 0) then
            call plsout (" RE") 
         endif
C
C       Update our idea of where the pen is.
C
         xold = x + (nch * h * fac * cosang)
         yold = y + (nch * h * fac * sinang)
         call plcout (char(10))
      endif
      return
      end
c
c
c
      subroutine limits(str, first, last)
c     
c     This subroutine finds the "FIRST" and the "LAST" non-blank
c     characters in the string "STR". The length of the string is not 
c     numerically  limited, but its length is determined when called.
c     "I" and "IB" are the forward and backward counters. 
c
      character str*(*)
      integer first, last, i, ib
c
      first = 0
      last = 0
      do i = 1, len(str)
         if (first .eq. 0) then
            if (str(i:i) .ne. ' ') first = i
         end if
c
         if (last .eq. 0) then
            ib = (len(str) - i) + 1
            if (str(ib:ib) .ne. ' ') last = ib
         end if
      end do
      return 
      end