subroutine anyplt ( icom )
!
!***********************************************************************
!
!! ANYPLT is an interface routine to a variety of graphics packages.
!
!
!  Discussion:
!
!    ANYPLT is a subroutine which provides a simple, standard interface
!    between FORTRAN programs and various output devices.  To run a
!    program which calls ANYPLT on a different machine, the program
!    is not modified in any way, but a different version of the ANYPLT
!    program is provided.  Currently, the following versions are available:
!
!    ANYATT - AT&T PC6300 graphics (640 by 400).  Requires ATTPLT.ASM.
!    ANYBUG - Simple debugging output to a file.
!    ANYCAL - CALCOMP file output.  Available on many mainframes.
!    ANYIBM - IBM PC hi resolution (640 by 200).  Requires IBMPLT.ASM.
!    ANYMAC - Macintosh graphics.  Requires auxilliary routine TOOLBX.SUB.
!    ANYNCR - NCAR graphics package.
!    ANYNUL - Does nothing.
!    ANYP10 - PLOT10 interactive graphics. (1024 by 768)
!    ANYTTY - Simple 'typewriter' graphics (80 by 24)
!
!    The symbolic output of characters, numbers and other printable
!    characters was made possible by adaptation of a routine written
!    by Bill Furey of the University of Pittsburgh, Department of
!    Crystallography.
!
!  Modified:
!
!    21 November 2000
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer ICOM, specifies the graphics request being made.
!    0, enable graphics.
!    1, disable graphics.
!    2, begin plot.
!    3, define plot size.
!    4, move to a point.
!    5, draw to a point.
!    6, clear screen.
!    7, write string at position.
!    8, use virtual cursor.
!    9, end plot.
!    10, ring bell.
!    11, mark data.
!    12, return screen data.
!    13, return version.
!    14, draw an arrow.
!
  real angle
  character ( len = 80 ) carray
  real csize
  real cwide
  real degrees_to_radians
  character ( len = 10 ), save :: dev
  logical filled
  character flush
  integer i
  integer icmax
  integer icmin
  integer icom
  integer iplt1
  integer iplt2
  integer itable
  integer ixplt1
  integer ixplt2
  integer iyplt1
  integer iyplt2
  integer lent
  integer marray
  integer ndraw
  integer, save :: nplot = 0
  integer nval
  real pwide
  logical s_eqi
  real x2
  real xdraw(6)
  real xplt1
  real xplt2
  real, save :: xpmax
  real, save :: xpmin
  real xval(2)
  real y2
  real ydraw(6)
  real yplt1
  real yplt2
  real, save :: ypmax
  real, save :: ypmin
  real yval(2)
!
  common /anycom/ iplt1, iplt2, ixplt1, ixplt2, iyplt1, &
                  iyplt2, marray, xplt1, xplt2, yplt1, yplt2
  common /anychr/ carray
!
!  ICOM = 0  Enable graphics
!
  if ( icom == 0 ) then

    if ( s_eqi ( carray, 'cgm' ) ) then
      dev = 'cgmb'
    else if ( s_eqi ( carray, 'cgmb' ) ) then
      dev = 'cgmb'
    else if ( s_eqi ( carray, 'ps' ) ) then
      dev = 'ps'
    else if ( s_eqi ( carray, 'xws' ) ) then
      dev = 'xws'
    else
      return
    end if

    write ( *, * ) 'Using graphics device ' // trim ( dev )

    call device ( dev )

    if ( dev == 'cgmb' ) then
      call outfil ( 'anyplt.cgm' )
    else if ( dev == 'ps' ) then
      call outfil ( 'anyplt.ps' )
    end if

    icmax = 200
    icmin = 2
    itable = 1
    call color_table_set ( icmin, icmax, itable )

    nplot = 0
!
!  ICOM = 1  Disable graphics
!
  else if ( icom == 1 ) then
    call grfcls
!
!  ICOM = 2  Begin plot
!
  else if ( icom == 2 ) then

    if ( nplot == 0 ) then

      call grfini

      xval(1) = 0.0E+00
      xval(2) = 1.0E+00
      yval(1) = 0.0E+00
      yval(2) = 1.0E+00
      nval = 2
      call setscl ( xval, yval, nval )
      nplot = 1

    else

      call newfrm
      nplot = nplot + 1

    end if
!
!  ICOM = 3  Define plot size
!
  else if ( icom == 3 ) then

    xpmin = xplt1
    xpmax = xplt1 + xplt2
    ypmin = yplt1
    ypmax = yplt1 + yplt2

    xval(1) = xpmin
    xval(2) = xpmax
    yval(1) = ypmin
    yval(2) = ypmax
    nval = 2

    call setscl ( xval, yval, nval )
!
!  ICOM = 4  Move to point
!
  else if ( icom == 4 ) then

    call movcgm ( xplt1, yplt1 )
!
!  ICOM = 5  Draw to point
!
  else if ( icom == 5 ) then

    call drwcgm ( xplt1, yplt1 )
!
!  ICOM = 6  Clear screen
!
  else if ( icom == 6 ) then
!
!    call newfrm
!
!  ICOM = 7,  Write string at position
!
  else if ( icom == 7 ) then

    angle = 0.0E+00
    cwide = 0.025E+00
    pwide = 1.0E+00
    lent = len_trim ( carray )
    flush = 'c'

    call s_plot ( angle, cwide, pwide, trim ( carray ), xplt1, yplt1, flush )
!
!  ICOM = 8  Use virtual cursor
!
  else if ( icom == 8 ) then
!
!  ICOM = 9  End plot
!
  else if ( icom == 9 ) then

    if ( s_eqi ( dev, 'XWS' ) ) then

      call movcgm ( xpmin, ypmin )

      do i = 1, 100
        call drwcgm ( xpmax, ypmin )
        call drwcgm ( xpmax, ypmax )
        call drwcgm ( xpmin, ypmax )
        call drwcgm ( xpmin, ypmin )
      end do

    end if
!
!  ICOM = 10  Ring bell
!
  else if ( icom == 10 ) then
!
!  ICOM = 11  Mark data
!
  else if ( icom == 11 ) then

    filled = .false.
    csize = 0.005E+00
    call circle ( xplt1, yplt1, csize, filled )
!
!  ICOM = 12  Return screen data
!
  else if ( icom == 12 ) then
!
!  ICOM = 13  Return version
!
  else if ( icom == 13 ) then
    carray = 'ANYPLT - Version 1.03  21 November 2000  CGMPLT'
!
!  ICOM = 14, draw an arrow.
!
  else if ( icom == 14 ) then
    x2 = xplt1 + yplt2 * cos ( degrees_to_radians ( xplt2 ) )
    y2 = yplt1 + yplt2 * sin ( degrees_to_radians ( xplt2 ) )
    call arrow ( xplt1, yplt1, x2, y2, xdraw, ydraw )
    call movcgm ( xdraw(1), ydraw(1) )
    do i = 2, 6
      call drwcgm ( xdraw(i), ydraw(i) )
    end do
!
!  Unknown value of ICOM.
!
  else
    write ( *, * ) 'ANYPLT - Fatal error!'
    write ( *, * ) '  Unknown value of ICOM = ',icom
    stop
  end if

  return
end
subroutine arrow ( xstart, ystart, xtip, ytip, xdraw, ydraw )
!
!***********************************************************************
!
!! ARROW returns points that specify an arrow from one point to another.
!
!
!  Discussion:
!
!    The arrow will stretch between two user specified points.
!
!    The "head" of the arrow may be fatter or thinner than expected
!    if the X and Y scales of the graph are not in the same
!    proportions.
!
!
!                       left(3)
!                        |\
!                        | \
!                        |  \
!    start(1)*-----base(2,6) * tip(4)
!                        |  /
!                        | /
!                        |/
!                       rite(5)
!
!
!  Modified:
!
!    20 November 2000
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, real XSTART, YSTART, the starting point for the arrow.
!
!    Input, real XTIP, YTIP, the end point for the arrow.
!
!    Output, real XDRAW(6), YDRAW(6), the X and Y coordinates
!    of the points to connect to draw the arrow.
!
  real alpha
  real del
  real dist
  real pi
  real theta
  real xbase
  real xdraw(6)
  real xleft
  real xrite
  real xstart
  real xtip
  real ybase
  real ydraw(6)
  real yleft
  real yrite
  real ystart
  real ytip
!
  theta = 0.5E+00 * pi ( ) - atan2 ( 2.0E+00, 1.0E+00 )
  dist = sqrt ( ( xtip - xstart )**2 + ( ytip - ystart )**2 )
  alpha = atan2 ( ytip - ystart, xtip - xstart )
  del = sqrt ( 5.0E+00 ) / 3.0E+00

  xbase = ( xstart + 2.0E+00 * xtip ) / 3.0E+00
  ybase = ( ystart + 2.0E+00 * ytip ) / 3.0E+00

  xleft = xstart + del * dist * cos ( alpha - theta )
  yleft = ystart + del * dist * sin ( alpha - theta )

  xrite = xstart + del * dist * cos ( alpha + theta )
  yrite = ystart + del * dist * sin ( alpha + theta )

  xdraw(1:6) = (/ xstart, xbase, xleft, xtip, xrite, xbase /)
  ydraw(1:6) = (/ ystart, ybase, yleft, ytip, yrite, ybase /)

  return
end
subroutine ch_cap ( c )
!
!*******************************************************************************
!
!! CH_CAP capitalizes a single character.
!
!
!  Modified:
!
!    19 July 1998
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input/output, character C, the character to capitalize.
!
  character c
  integer itemp
!
  itemp = ichar ( c )

  if ( 97 <= itemp .and. itemp <= 122 ) then
    c = char ( itemp - 32 )
  end if

  return
end
subroutine color_table_set ( icmin, icmax, itable )
!
!*******************************************************************************
!
!! COLOR_TABLE_SET sets up the color table.
!
!
!  Discussion:
!
!    This routine replaces the unreliable DRAWCGM routine SETCTB.
!
!    The routine sets the colors between ICMIN and ICMAX, which
!    should typically be 2 and 255.
!
!    It will also set the values of color 0 to white, and
!    color 1 to black.
!
!  Modified:
!
!    21 November 2000
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer ICMIN, ICMAX, the minimum and maximum color indices.
!
!    Input, integer ITABLE, the desired table.
!
!    1: low black to high white
!    2: low white to high black.
!    3: low blue to high yellow
!    4: low red, high blue, with bands between.
!    5: low red, yellow, green, blue, high white.
!    5: low white, blue, green, yellow, high red.
!    7: low blue to high red
!
  real bhi
  real blo
  real bval
  real ghi
  real glo
  real gval
  integer i
  integer icmax
  integer icmin
  integer icol1
  integer icol2
  integer itable
  integer ival
  real pi
  real rhi
  real rlo
  real rval
  real temp
  real theta
!
  icmin = max ( icmin, 2 )
  icmax = min ( icmax, 255 )
!
!  1: Low black to high white
!  2: Low white to high black
!  3: Low blue to high yellow.
!  4: Low red, high blue, with bands between.
!  5: Low red, yellow, green, blue, high white.
!  6: Low white, blue, green, yellow, high red.
!  7: Low blue to high red
!
    do i = icmin, icmax

      if ( icmin == icmax ) then
        temp = 0.5E+00
      else
        temp = real ( i - icmin ) / real ( icmax - icmin )
      end if

      if ( itable == 1 ) then
        bval = temp
        gval = temp
        rval = temp
      else if ( itable == 2 ) then
        bval = 1.0E+00 - temp
        gval = 1.0E+00 - temp
        rval = 1.0E+00 - temp
      else if ( itable == 3 ) then
        rval = temp
        gval = temp
        bval = 1.0E+00 - temp
      else if ( itable == 4 ) then
        theta = 0.5E+00 * pi() * temp
        rval = cos ( theta )**2
        bval = sin ( theta )**2
        gval = 0.8E+00 * sin ( 10.0E+00 * theta )**6
      else if ( itable == 5 ) then
        theta = 4.0E+00 * temp
        rval = exp(-(theta-1.0E+00)**2) + exp(-(theta-4.0E+00)**2)
        gval = exp(-(theta-2.0E+00)**2) + exp(-(theta-4.0E+00)**2)
        bval = exp(-(theta-3.0E+00)**2) + exp(-(theta-4.0E+00)**2)
        rval = max ( rval, 0.0E+00 )
        rval = min ( rval, 1.0E+00 )
        gval = max ( gval, 0.0E+00 )
        gval = min ( gval, 1.0E+00 )
        bval = max ( bval, 0.0E+00 )
        bval = min ( bval, 1.0E+00 )
      else if ( itable == 6 ) then
        theta = 4.0E+00 * temp
        rval = exp(-(theta-1.0E+00)**2) + exp(-(theta-4.0E+00)**2)
        gval = exp(-(theta-2.0E+00)**2) + exp(-(theta-4.0E+00)**2)
        bval = exp(-(theta-3.0E+00)**2) + exp(-(theta-4.0E+00)**2)
        rval = max ( rval, 0.0E+00 )
        rval = min ( rval, 1.0E+00 )
        gval = max ( gval, 0.0E+00 )
        gval = min ( gval, 1.0E+00 )
        bval = max ( bval, 0.0E+00 )
        bval = min ( bval, 1.0E+00 )
      else if ( itable == 7 ) then
        rval = temp
        gval = 0.0E+00
        bval = 1.0E+00 - temp
      end if

      ival = i
      call setclr ( ival, rval, gval, bval )

    end do
!
!  Background color 0 is to be white.
!
  ival = 0
  rval = 1.0E+00
  gval = 1.0E+00
  bval = 1.0E+00
  call setclr ( ival, rval, gval, bval )
!
!  Foreground color 1 is to be black.
!
  ival = 1
  rval = 0.0E+00
  gval = 0.0E+00
  bval = 0.0E+00
  call setclr ( ival, rval, gval, bval )

  return
end
function degrees_to_radians ( angle )
!
!*******************************************************************************
!
!! DEGREES_TO_RADIANS converts an angle from degrees to radians.
!
!
!  Modified:
!
!    10 July 1999
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, real ANGLE, an angle in degrees.
!
!    Output, real DEGREES_TO_RADIANS, the equivalent angle
!    in radians.
!
  real, parameter :: pi = 3.14159265358979323846264338327950288419716939937510E+00

  real angle
  real degrees_to_radians

  degrees_to_radians = ( angle / 180.0E+00 ) * pi

  return
end
function pi ( )
!
!*******************************************************************************
!
!! PI returns the value of pi.
!
!
!  Modified:
!
!    04 December 1998
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Output, real PI, the value of pi.
!
  real pi
!
  pi = 3.14159265358979323846264338327950288419716939937510E+00

  return
end
function s_eqi ( s1, s2 )
!
!*******************************************************************************
!
!! S_EQI is a case insensitive comparison of two strings for equality.
!
!
!  Examples:
!
!    S_EQI ( 'Anjana', 'ANJANA' ) is .TRUE.
!
!  Modified:
!
!    14 April 1999
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, character ( len = * ) S1, S2, the strings to compare.
!
!    Output, logical S_EQI, the result of the comparison.
!
  character c1
  character c2
  integer i
  integer len1
  integer len2
  integer lenc
  logical s_eqi
  character ( len = * ) s1
  character ( len = * ) s2
!
  len1 = len ( s1 )
  len2 = len ( s2 )
  lenc = min ( len1, len2 )

  s_eqi = .false.

  do i = 1, lenc

    c1 = s1(i:i)
    c2 = s2(i:i)
    call ch_cap ( c1 )
    call ch_cap ( c2 )

    if ( c1 /= c2 ) then
      return
    end if

  end do

  do i = lenc + 1, len1
    if ( s1(i:i) /= ' ' ) then
      return
    end if
  end do

  do i = lenc + 1, len2
    if ( s2(i:i) /= ' ' ) then
      return
    end if
  end do

  s_eqi = .true.

  return
end
subroutine s_plot ( angle, cwide, pwide, s, x, y, flush )
!
!*******************************************************************************
!
!! S_PLOT plots a character string onto a graphics image.
!
!
!  Discussion:
!
!    The string can be at any angle and at any size.
!
!    The plot is assumed to be of size PWIDE by PHITE, although PHITE
!    itself is not input.
!
!  Warning:
!
!    This routine must be modified to work with a particular graphics package.
!    The current code calls two routines:
!      MOVCGM ( X, Y ) moves to a point (X,Y) in the plot;
!      DRWCGM ( X, Y ) draws a line from the current point to (X,Y).
!
!  Modified:
!
!    21 November 2000
!
!  Parameters:
!
!    Input, real ANGLE, the angle in degrees at which the
!    string is to be drawn.  0 is typical.  90 degrees would
!    cause the string to be written from top to bottom.
!
!    Input, real CWIDE, the width of the characters.  This
!    is measured in the same units as the plot width PWIDE.
!    For PWIDE = 1, a plot size of 0.025 would be reasonable,
!    since 40 characters would fit, but 2.0 would be nonsense.
!
!    Input, real PWIDE, the width of the plot, in the same
!    units as CWIDE.
!
!    Input, character ( len = * ) S, contains the text to be plotted.
!    Only characters with ASCII codes between 32 and 126 will actually
!    be plotted.  Any other characters are "unprintable", and will be
!    plotted as blanks.
!
!    Input, real X, Y, the coordinates of a point which
!    determines where the string is drawn.  The string will
!    be drawn starting at, centered or, or ending at (X,Y),
!    depending on the value of FLUSH.
!
!    Input, character ( len = * ) FLUSH, a string which specifies how to
!    place the string.  Only the first character of FLUSH is examined, and
!    the case of the character is not important.
!
!    'L' - the string will be drawn flush left.
!    'C' - the string will be centered.
!    'R' - the string will be drawn flush right.
!
  real angle
  real ca
  character c
  real cwide
  real degrees_to_radians
  character ( len = * ) flush
  integer i
  integer iascii
  integer icr
  integer, save, dimension ( 1617 ) :: ifont
  integer ip
  integer ipen
  integer, save, dimension ( 95 ) :: ipoint
  integer iv
  integer nchar
  integer nmax
  integer nvec
  real pwide
  logical rotate
  character ( len = * ) s
  real sa
  real scl2
  real x
  real xb
  real xc
  real xcopy
  real xnew
  real xold
  real xrot
  real xt
  real y
  real yb
  real yc
  real ycopy
  real ynew
  real yold
  real yrot
  real yt
!
!  IPOINT is a pointer array into IFONT.
!
!  IPOINT(I) records where the "strokes" for character I begin
!  in the IFONT array.
!
  data ( ipoint(i), i = 1, 95 ) / &
       1,   3,  26,  45,  66, 102, 130, 156, 166, 186, 206, 222, 233, &
     249, 255, 267, 273, 293, 306, 328, 353, 363, 383, 411, 423, 457, &
     483, 506, 533, 541, 552, 560, 587, 625, 638, 665, 683, 699, 714, &
     727, 754, 770, 786, 805, 818, 826, 838, 848, 868, 884, 909, 930, &
     956, 967, 981, 989,1001,1012,1025,1035,1045,1051,1061,1069,1075, &
    1081,1108,1131,1149,1172,1194,1214,1243,1260,1284,1307,1323,1336, &
    1364,1381,1401,1424,1447,1464,1486,1499,1516,1524,1536,1547,1560, &
    1570,1586,1592,1608 /
!
!  IFONT contains the strokes defining the various symbols.
!
  data ( ifont(i), i = 1, 396 ) / &
     1, 0, 2,10,11, 9,22,10,23,11,22,10,11, 0, 9, 7, 9, 9,11, 9,11, 7, &
     9, 7, 0, 2, 8,17, 7,23, 9,23, 8,17, 0,14,17,13,23,15,23,14,17, 0, &
     4, 9,23, 7, 7, 0,13,23,11, 7, 0, 5,17,15,17, 0, 5,13,15,13, 0, 3, &
    15,19,13,21, 9,21, 7,19, 7,17, 9,15,13,15,15,13,15,11,13, 9, 9, 9, &
     7,11, 0, 9,23, 9, 7, 0,13,23,13, 7, 0, 3, 5,23, 9,23, 9,19, 5,19, &
     5,23, 0,17,23, 5, 7, 0,13, 7,13,11,17,11,17, 7,13, 7, 0, 1,17, 7, &
     7,17, 7,19, 9,21,13,21,15,19,15,17, 5,13, 5,11, 9, 7,13, 7,17,15, &
     0, 1,10,17, 9,23,11,23,10,17, 0, 1,12,23,11,21,10,19, 9,17, 9,15, &
     9,13,10,11,11, 9,12, 7, 0, 1,12,23,13,21,14,19,15,17,15,15,15,13, &
    14,11,13, 9,12, 7, 0, 3, 7,15,15,15, 0,13,19, 9,11, 0, 9,19,13,11, &
     0, 2, 7,15,15,15, 0,11,19,11,11, 0, 1,11, 7, 9, 7, 9, 9,11, 9,11, &
     7,11, 6,10, 4, 0, 1, 7,15,15,15, 0, 1, 9, 7, 9, 9,11, 9,11, 7, 9, &
     7, 0, 1,15,23, 7, 7, 0, 1, 9,23,13,23,15,19,15,11,13, 7, 9, 7, 7, &
    11, 7,19, 9,23, 0, 2, 7,21, 9,23, 9, 7, 0, 7, 7,11, 7, 0, 1, 5,21, &
     9,23,15,23,17,21,17,19,15,17, 7,13, 5,10, 5, 7,17, 7, 0, 2, 5,23, &
    17,23,15,17,13,15, 9,15, 0,13,15,17,13,17,10,14, 7, 8, 7, 5,10, 0, &
     1,13, 7,13,23, 5,13,17,13, 0, 1,17,23, 5,23, 5,17,13,17,17,15,17, &
    11,13, 7, 9, 7, 5,11, 0, 1,17,19,13,23, 9,23, 5,19, 5,13, 9,15,13 /

  data ( ifont(i), i =  397, 792 ) / &
    15,17,13,17,11,13, 7, 9, 7, 5,11, 5,13, 0, 1, 5,19, 5,23,17,23,11, &
    15,11, 7, 0, 1, 8,15, 6,17, 6,21, 8,23,14,23,16,21,16,17,14,15, 8, &
    15, 5,13, 5, 9, 8, 7,14, 7,17, 9,17,13,14,15, 0, 1,17,17,15,15, 7, &
    15, 5,17, 5,21, 7,23,15,23,17,21,17,11,15, 7, 7, 7, 5,11, 0, 2, 9, &
    13, 9,15,11,15,11,13, 9,13, 0, 9, 7, 9, 9,11, 9,11, 7, 9, 7, 0, 2, &
     9,13, 9,15,11,15,11,13, 9,13, 0,11, 7, 9, 7, 9, 9,11, 9,11, 7,11, &
     6,10, 4, 0, 1,17,21, 5,15,17, 9, 0, 2, 7,15,15,15, 0, 7, 9,15, 9, &
     0, 1, 5,21,17,15, 5, 9, 0, 2, 7,21, 9,23,13,23,15,21,15,19,11,15, &
    11,11, 0,10, 7,10, 9,12, 9,12, 7,10, 7, 0, 1,13, 7, 9, 7, 5,11, 5, &
    19, 9,23,13,23,17,19,17,11,15, 9,13,11,12,10,10,10, 9,11, 9,15,10, &
    16,12,16,13,15,13,11, 0, 2, 5, 7,11,23,17, 7, 0, 8,15,14,15, 0, 2, &
     5, 7, 5,23,15,23,17,21,17,17,15,15, 5,15, 0,15,15,17,13,17, 9,15, &
     7, 5, 7, 0, 1,17,19,13,23, 9,23, 5,19, 5,11, 9, 7,13, 7,17,11, 0, &
     1, 5, 7, 5,23,13,23,17,19,17,11,13, 7, 5, 7, 0, 2,17,23, 5,23, 5, &
     7,17, 7, 0, 5,15,12,15, 0, 2, 5, 7, 5,23,17,23, 0, 5,15,12,15, 0, &
     2,17,19,13,23, 9,23, 5,19, 5,11, 9, 7,13, 7,17,11,17,15,13,15, 0, &
    17,11,17, 7, 0, 3, 5, 7, 5,23, 0, 5,15,17,15, 0,17,23,17, 7, 0, 3, &
     9,23,13,23, 0,11,23,11, 7, 0, 9, 7,13, 7, 0, 2,15,23,15,11,12, 7 /

  data ( ifont(i), i =  793, 1188 ) / &
     8, 7, 5,11, 5,13, 0,13,23,17,23, 0, 2, 5, 7, 5,23, 0,17,23, 5,15, &
    17, 7, 0, 1, 5,23, 5, 7,17, 7, 0, 1, 5, 7, 5,23,11,11,17,23,17, 7, &
     0, 1, 5, 7, 5,23,17, 7,17,23, 0, 1,17,19,13,23, 9,23, 5,19, 5,11, &
     9, 7,13, 7,17,11,17,19, 0, 1, 5, 7, 5,23,13,23,17,21,17,17,13,15, &
     5,15, 0, 2,17,19,13,23, 9,23, 5,19, 5,11, 9, 7,13, 7,17,11,17,19, &
     0,13,11,17, 7, 0, 2, 5, 7, 5,23,13,23,17,21,17,17,13,15, 5,15, 0, &
    13,15,17, 7, 0, 1,17,19,13,23, 9,23, 5,20, 5,18, 9,15,13,15,17,12, &
    17,10,13, 7, 9, 7, 5,10, 0, 2, 5,23,17,23, 0,11,23,11, 7, 0, 1, 5, &
    23, 5,10, 8, 7,14, 7,17,10,17,23, 0, 1, 5,23,11, 7,17,23, 0, 1, 5, &
    23, 8, 7,11,17,14, 7,17,23, 0, 2, 5,23,17, 7, 0,17,23, 5, 7, 0, 2, &
     5,23,11,13,17,23, 0,11,13,11, 7, 0, 1, 5,23,17,23, 5, 7,17, 7, 0, &
     1,11,23, 7,23, 7, 7,11, 7, 0, 1, 7,23,15, 7, 0, 1, 7,23,11,23,11, &
     7, 7, 7, 0, 1, 7,21,11,23,15,21, 0, 1, 5, 3,17, 3, 0, 1, 9,23,13, &
    19, 0, 2, 7,14, 9,15,13,15,15,14,15, 7, 0,15,12, 9,12, 7,11, 7, 8, &
     9, 7,13, 7,15, 8, 0, 2, 7,23, 7, 7, 0, 7,13, 9,15,13,15,15,13,15, &
     9,13, 7, 9, 7, 7, 9, 0, 1,15,13,13,15, 9,15, 7,13, 7, 9, 9, 7,13, &
     7,15, 9, 0, 2,15,13,13,15, 9,15, 7,13, 7, 9, 9, 7,13, 7,15, 9, 0, &
    15,23,15, 7, 0, 1, 7,11,15,11,15,13,13,15, 9,15, 7,13, 7, 9, 9, 7 /

  data ( ifont(i), i = 1189, 1584 ) / &
    13, 7,15, 9, 0, 3, 9, 7, 9,23,13,23,13,22, 0, 8,15,12,15, 0, 8, 7, &
    11, 7, 0, 2,15,13,13,15, 9,15, 7,13, 7, 9, 9, 7,13, 7,15, 9, 0,15, &
    13,15, 3,13, 1, 9, 1, 7, 3, 0, 2, 7, 7, 7,23, 0, 7,14, 9,15,13,15, &
    15,14,15, 7, 0, 3, 9,15,11,15,11, 7, 0, 9, 7,13, 7, 0, 9,17, 9,19, &
    11,19,11,17, 9,17, 0, 2, 9,15,11,15,11, 1, 7, 1, 7, 3, 0, 9,17,11, &
    17,11,19, 9,19, 9,17, 0, 3, 7, 7, 7,23, 0,15,15, 7,10, 0, 9,11,15, &
     7, 0, 2, 9,23,11,23,11, 7, 0, 9, 7,13, 7, 0, 3, 7,15, 7, 7, 0, 7, &
    14, 8,15,10,15,11,14,11, 7, 0,11,14,12,15,14,15,15,14,15, 7, 0, 2, &
     7, 7, 7,15, 0, 7,14, 9,15,13,15,15,14,15, 7, 0, 1, 7,13, 9,15,13, &
    15,15,13,15, 9,13, 7, 9, 7, 7, 9, 7,13, 0, 2, 7,13, 9,15,13,15,15, &
    13,15, 9,13, 7, 9, 7, 7, 9, 0, 7,14, 7, 1, 0, 2,15,13,13,15, 9,15, &
     7,13, 7, 9, 9, 7,13, 7,15, 9, 0,15,14,15, 1, 0, 2, 7,15, 9,15, 9, &
     7, 0, 9,13,11,15,13,15,15,13, 0, 1,15,13,13,15, 9,15, 7,13, 9,11, &
    13,11,15, 9,13, 7, 9, 7, 7, 9, 0, 2, 9,23, 9, 7,11, 7, 0, 7,17,11, &
    17, 0, 2, 7,15, 7, 9, 9, 7,13, 7,15, 9, 0,15,15,15, 7, 0, 1, 7,15, &
    11, 7,15,15, 0, 1, 7,15, 9, 7,11,11,13, 7,15,15, 0, 2, 7,15,15, 7, &
     0, 7, 7,15,15, 0, 2, 7,15,11, 7, 0,15,15,10, 5, 7, 1, 0, 1, 7,15, &
    15,15, 7, 7,15, 7, 0, 1,11,23, 7,23, 9,17, 7,15, 9,13, 7, 7,11, 7 /

  data ( ifont(i), i = 1585, 1617 ) / &
     0, 1, 9,23, 9, 7, 0, 1, 7,23,11,23, 9,17,11,15, 9,13,11, 7, 7, 7, &
     0, 1, 5,21, 7,23,15,21,17,23, 0 /
!
  nchar = len_trim ( s )

  if ( pwide <= 0 ) then
    write ( *, * ) ' '
    write ( *, * ) 'S_PLOT - Serious error!'
    write ( *, * ) '  The plot width PWIDE is negative!'
    write ( *, * ) '  PWIDE = ', pwide
    return
  end if
!
!  Chop titles that are too long.  To do this, we need to know the
!  width of the plot (PWIDE) in same units as CWIDE.
!
  nmax = int ( pwide / cwide )

  if ( nchar > nmax ) then
    nchar = nmax
  end if
!
!  Shift string if centering or right flush option used.
!
  if ( flush(1:1) == 'l' .or. flush(1:1) == 'L' ) then
    xcopy = x
    ycopy = y
  else if ( flush(1:1) == 'c' .or. flush(1:1) == 'C' ) then
    xcopy = x - 0.5E+00 * nchar * cwide * cos ( degrees_to_radians ( angle ) )
    ycopy = y - 0.5E+00 * nchar * cwide * sin ( degrees_to_radians ( angle ) )
  else if ( flush(1:1) == 'r' .or. flush(1:1) == 'R' ) then
    xcopy = x - nchar * cwide * cos ( degrees_to_radians ( angle ) )
    ycopy = y - nchar * cwide * sin ( degrees_to_radians ( angle ) )
  else
    xcopy = x
    ycopy = y
  end if
!
!  Note that screen coordinates are used.
!  Thus a width of 0.1 is intended to mean 1/10 of screen size.
!
!  Set the scale factor for character height.
!
  scl2 = cwide / 16.0E+00
!
!  Set the starting point for the line of text, the lower left
!  corner of the first character.
!
!  Set the origin about which rotation is performed.
!
  xb = xcopy
  xrot = xcopy
  yb = ycopy
  yrot = ycopy
!
!  Get trig functions if rotation required, converting from
!  degrees to radians.
!
  if ( angle == 0.0E+00 ) then
    rotate = .false.
  else
    ca = cos ( degrees_to_radians ( angle ) )
    sa = sin ( degrees_to_radians ( angle ) )
    rotate = .true.
  end if
!
!  Loop over all characters in the string.
!
  do icr = 1, nchar

    xold = x
    yold = y
    xnew = x
    ynew = y
!
!  Get the ASCII code for the character and shift by 31 so that
!  the first printable character becomes code 1.
!
    c = s(icr:icr)
    iascii = ichar ( c ) - 31
!
!  Replace any nonprintable characters with blanks.
!
    if ( iascii < 1 .or. iascii > 95 ) then
      iascii = 1
    end if
!
!  Get the pointer to this character in font table.
!
    ip = ipoint(iascii)
!
!  Get the number of "vectors" required to draw the character.
!  Here "vectors" means the number of times the pen is lowered, not
!  the number of pen strokes.
!
!  For blanks, this number is 1, due to the way the
!  algorithm is coded.
!
    nvec = ifont(ip)
!
!  Loop over all required pen movements.
!
    do iv = 1, nvec

      ipen = 3
      ip = ip + 1

      do while ( ifont(ip) /= 0 )

        xc = xb + scl2 * ( ifont(ip) - 1 )
        yc = yb + scl2 * ( ifont(ip+1) - 7 )
!
!  Apply rotation if necessary.
!
        if ( rotate ) then
          xt = xc - xrot
          yt = yc - yrot
          xc = xrot + ca * xt - sa * yt
          yc = yrot + sa * xt + ca * yt
        end if
!
!  Plot the pen stroke.
!
        if ( ipen == 3 ) then
          xnew = xc
          ynew = yc
        else
          xold = xnew
          yold = ynew
          xnew = xc
          ynew = yc
          call movcgm ( xold, yold )
          call drwcgm ( xnew, ynew )
        end if

        ipen = 2
        ip = ip + 2

      end do

    end do
!
!  Advance the base to compensate for character just drawn.
!
    xb = xb + cwide

  end do

  return
end