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.
!
  implicit none
!
  real angle
  real degrees_to_radians
  real, parameter :: pi = &
    3.14159265358979323846264338327950288419716939937510E+00
!
  degrees_to_radians = ( angle / 180.0E+00 ) * pi

  return
end
subroutine hexagonal_1 ( ngrid, file_name )
!
!*******************************************************************************
!
!! HEXAGONAL_1 draws a simple hexagonal grid.
!
!
!  Modified:
!
!    07 June 2000
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer NGRID, specifies the number of "grid lines" drawn in
!    each of the three hexagonal directions.  
!
!    Input, character ( len = * ) FILE_NAME, the name of the file to which the
!    output should be written.
!
  implicit none
!
  character ( len = * ) file_name
  integer i
  integer ierror
  integer iunit
  integer j
  integer n
  integer ngrid
  integer pax
  integer pay
  integer pbx
  integer pby
  integer pcx
  integer pcy
  integer px
  integer px1
  integer px2
  integer py
  integer py1
  integer py2
  real xmax
  real xmin
  real ymax
  real ymin
!
!  Open the output file.
!
  iunit = 1

  call ps_create ( file_name, iunit, ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'HEXAGONAL_1'
    write ( *, '(a,i6)' ) '  File creation error ', ierror
    stop
  end if
!
!  Write the header.
!
  xmin = 0.0E+00
  ymin = 0.0E+00

  xmax = 8.5E+00
  ymax = 11.0E+00

  call ps_head ( file_name, iunit, xmin, xmax, ymin, ymax )
!
!  Draw the grid lines.
!
  pax =  36
  pay = 136

  pbx = 576
  pby = 136

  pcx = 306
  pcy = 568

  n = 3 * ngrid

  do i = 0, n-1

    write ( iunit, '(a)' ) ' newpath'

    px1 = int ( real ( ( n - i ) * pax + i * pbx ) / real ( n ) )
    py1 = int ( real ( ( n - i ) * pay + i * pby ) / real ( n ) )

    px2 = int ( real ( ( n - i ) * pcx + i * pbx ) / real ( n ) )
    py2 = int ( real ( ( n - i ) * pcy + i * pby ) / real ( n ) )

    do j = mod ( i+1, 3 ), n - i - 1, 3

      px = int ( real ( ( n - i - j ) * px1 + j * px2 ) / real ( n - i ) )
      py = int ( real ( ( n - i - j ) * py1 + j * py2 ) / real ( n - i ) )
      write ( iunit, '(2i4,a)' ) px, py, ' moveto'

      px = int ( real ( ( n - i - 1 - j ) * px1 + ( j + 1 ) * px2 ) &
        / real ( n - i ) )
      py = int ( real ( ( n - i - 1 - j ) * py1 + ( j + 1 ) * py2 ) &
        / real ( n - i ) )
      write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    end do

    write ( iunit, '(a)' ) ' stroke'

  end do

  do i = 0, n-1

    write ( iunit, '(a)' ) ' newpath'

    px1 = int ( real ( ( n - i ) * pbx + i * pcx ) / real ( n ) )
    py1 = int ( real ( ( n - i ) * pby + i * pcy ) / real ( n ) )

    px2 = int ( real ( ( n - i ) * pax + i * pcx ) / real ( n ) )
    py2 = int ( real ( ( n - i ) * pay + i * pcy ) / real ( n ) )

    do j = mod ( i+1, 3 ), n - i - 1, 3

      px = int ( real ( ( n - i - j ) * px1 + j * px2 ) / real ( n - i ) )
      py = int ( real ( ( n - i - j ) * py1 + j * py2 ) / real ( n - i ) )
      write ( iunit, '(2i4,a)' ) px, py, ' moveto'

      px = int ( real ( ( n - i - 1 - j ) * px1 + ( j + 1 ) * px2 ) &
        / real ( n - i ) )
      py = int ( real ( ( n - i - 1 - j ) * py1 + ( j + 1 ) * py2 ) &
        / real ( n - i ) )
      write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    end do

    write ( iunit, '(a)' ) ' stroke'

  end do

  do i = 0, n-1

    write ( iunit, '(a)' ) ' newpath'

    px1 = int ( real ( ( n - i ) * pcx + i * pax ) / real ( n ) )
    py1 = int ( real ( ( n - i ) * pcy + i * pay ) / real ( n ) )

    px2 = int ( real ( ( n - i ) * pbx + i * pax ) / real ( n ) )
    py2 = int ( real ( ( n - i ) * pby + i * pay ) / real ( n ) )


    do j = mod ( i+1, 3 ), n - i - 1, 3

      px = int ( real ( ( n - i - j ) * px1 + j * px2 ) / real ( n - i ) )
      py = int ( real ( ( n - i - j ) * py1 + j * py2 ) / real ( n - i ) )
      write ( iunit, '(2i4,a)' ) px, py, ' moveto'

      px = int ( real ( ( n - i - 1 - j ) * px1 + ( j + 1 ) * px2 ) &
        / real ( n - i ) )
      py = int ( real ( ( n - i - 1 - j ) * py1 + ( j + 1 ) * py2 ) &
        / real ( n - i ) )
      write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    end do

    write ( iunit, '(a)' ) ' stroke'

  end do
!
!  Write the trailer.
!
  call ps_tail ( iunit )
!
!  Close the output file.
!
  close ( unit = iunit )

  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.
!
  implicit none
!
  real pi
!
  pi = 3.14159265358979323846264338327950288419716939937510E+00

  return
end
subroutine polar_1 ( angle_num, circle_num, file_name )
!
!*******************************************************************************
!
!! POLAR_1 draws a simple polar grid.
!
!
!  Modified:
!
!    02 June 2000
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer ANGLE_NUM, the number of angular grid lines.
!
!    Input, integer CIRCLE_NUM, the number of circular grid lines.
!
!    Input, character ( len = * ) FILE_NAME, the name of the file to which the
!    output should be written.
!
  implicit none
!
  real angle
  integer angle_max
  integer angle_min
  integer angle_num
  integer circle
  integer circle_num
  real degrees_to_radians
  character ( len = * ) file_name
  integer i
  integer ierror
  integer iunit
  integer pr
  integer prmax
  integer px
  integer pxcen
  integer pxmax
  integer pxmin
  integer py
  integer pycen
  integer pymax
  integer pymin
  integer thick
  integer thin
  real xmax
  real xmin
  real ymax
  real ymin
!
!  Open the output file.
!
  iunit = 1

  call ps_create ( file_name, iunit, ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'POLAR_1'
    write ( *, '(a,i6)' ) '  File creation error ', ierror
    stop
  end if
!
!  Write the header.
!
  xmin = 0.0E+00
  ymin = 0.0E+00

  xmax = 8.5E+00
  ymax = 11.0E+00

  call ps_head ( file_name, iunit, xmin, xmax, ymin, ymax )
!
!  Draw the radial grid lines.
!
  pxmin = 0 + 36
  pxmax = 612 - 36

  pymin = 0 + 36
  pymax = 792 - 36

  pxcen = 0.5E+00 * ( pxmin + pxmax )
  pycen = 0.5E+00 * ( pymin + pymax )

  prmax = pxmax - pxcen

  thin = 1
  thick = 2

  do i = 0, angle_num

    angle = real ( ( i - 1 ) * 360 ) / real ( angle_num )

    write ( iunit, '(a)' ) ' newpath'
    px = pxcen
    py = pycen
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    px = pxcen + real ( prmax ) * cos ( degrees_to_radians ( angle ) )
    py = pycen + real ( prmax ) * sin ( degrees_to_radians ( angle ) )
    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do
!
!  Draw the circular grid lines.
!
  angle_min = 0
  angle_max = 360

  do circle = 1, circle_num

    if ( mod ( circle, 2 ) == 0 ) then
      write ( iunit, '(i4,a)' ) thick, ' setlinewidth'
    else 
      write ( iunit, '(i4,a)' ) thin, ' setlinewidth'
    end if

    pr = int ( real ( circle * prmax ) / real ( circle_num ) )

    write ( iunit, '(a)' ) ' newpath'
    write ( iunit, '(5i4,a)' ) pxcen, pycen, pr, angle_min, angle_max, ' arc'
    write ( iunit, '(a)' ) ' closepath stroke'

  end do
!
!  Write the trailer.
!
  call ps_tail ( iunit )
!
!  Close the output file.
!
  close ( unit = iunit )

  return
end
subroutine ps_create ( filename, iunit, ierror )
!
!*******************************************************************************
!
!! PS_CREATE opens a new version of a PostScript file with a given name.
!
!
!  Note:
!
!    If a file of the given name already exists, it is deleted.
!
!  Modified:
!
!    09 April 2001
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer IUNIT, the FORTRAN unit to which output should
!    be written.
!
!    Input, character ( len = * ) FILE_NAME, the name of the output file.
!
!    Output, integer IERROR, error flag.
!    0, no error.
!    1, a file already existed of this name, and it could not be deleted.
!    2, the file could not be created.
!
  implicit none
!
  character ( len = * ) filename
  integer iunit
  integer ierror
  integer ios
  logical lexist
!
  ierror = 0
!
!  If a file of this name already exists, delete it.
!
  inquire ( file = filename, exist = lexist )
 
  if ( lexist ) then

    open (  unit = iunit, file = filename, status = 'old', iostat = ios )

    if ( ios /= 0 ) then
      ierror = 1
      return
    end if

    close ( unit = iunit, status = 'delete' )

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'PS_CREATE'
    write ( *, '(a)' ) '  Deleted old copy of ' // trim ( filename )

  end if
!
!  Now create a new empty file of the given name.
!
  open ( unit = iunit, file = filename, status = 'new', iostat = ios )

  if ( ios /= 0 ) then
    ierror = 2
    return
  end if

  return
end
subroutine ps_head ( file_name, iunit, xmin, xmax, ymin, ymax )
!
!*******************************************************************************
!
!! PS_HEAD writes header information to a PostScript file.
!
!
!  Modified:
!
!    04 November 1999
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, character ( len = * ) FILE_NAME, the name of the output file.
!
!    Input, integer IUNIT, the FORTRAN unit to which output should
!    be written.
!
!    Input, real XMIN, XMAX, YMIN, YMAX, the minimum and maximum X
!    and Y values of all data to be written to the file.  Any data
!    that lies outside this range will not show up properly.
!
  implicit none
!
  real alpha
  real blue
  character ( len = 9 ) date
  character ( len = * ) file_name
  real green
  integer iunit
  integer margin
  integer pagexmax
  integer pagexmin
  integer pageymax
  integer pageymin
  integer plotxmax
  integer plotxmin
  integer plotxmin2
  integer plotymax
  integer plotymin
  integer plotymin2
  real red
  character ( len = 10 ) time
  integer values(8)
  real xmax
  real xmin
  real ymax
  real ymin
  character ( len = 5 ) zone
!
!  Initialization.
!
  red = 0.0E+00
  green = 0.0E+00
  blue = 0.0E+00
!
!  Compute the scale factor.
!
  pagexmax = 612
  pagexmin = 0
  pageymax = 792
  pageymin = 0

  margin = 36

  plotxmax = pagexmax - margin
  plotxmin = pagexmin + margin
  plotymax = pageymax - margin
  plotymin = pageymin + margin

  alpha = min ( ( plotxmax - plotxmin ) / ( xmax - xmin ), &
                ( plotymax - plotymin ) / ( ymax - ymin ) )
!
!  Adjust PLOTXMIN and PLOTYMIN to center the image.
!
  plotxmin2 = 0.5E+00 * ( plotxmin + plotxmax - alpha * ( xmax - xmin ) )

  plotymin2 = 0.5E+00 * ( plotymin + plotymax - alpha * ( ymax - ymin ) )
!
!  Write the prolog.
!
  write ( iunit, '(a)' ) '%!PS-Adobe-3.0'
  write ( iunit, '(a)' ) '%%Document-Fonts: Times-Roman'
  write ( iunit, '(a,a)' ) '%%Title: ' , trim ( file_name )
  write ( iunit, '(a)' ) '%%Creator: WritePS'
  call date_and_time ( date, time, zone, values )
  write ( iunit, '(a,a)' ) '%%CreationDate: ', date
  write ( iunit, '(a,4i5)' ) '%%BoundingBox', plotxmin, plotymin, plotxmax, &
    plotymax
  write ( iunit, '(a)' ) '%%LanguageLevel: 2'
  write ( iunit, '(a)' ) '%%EndComments'
  write ( iunit, '(a)' ) '%%BeginProlog'
  write ( iunit, '(a)' ) '%%EndProlog'
!
!  Set line color.
!
  write ( iunit, '(3f7.4,a)' ) red, green, blue, ' setrgbcolor'
!
!  Store data.
!
  call ps_setting ( 'SET', alpha, plotxmin2, plotymin2, xmin, ymin )

  return
end
subroutine ps_setting ( action, alpha, plotxmin2, plotymin2, xmin, ymin )
!
!*******************************************************************************
!
!! PS_SETTING sets, returns, or prints some internal PostScript parameters.
!
!
!  Modified:
!
!    09 December 1998
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, character ( len = * ) ACTION, determines what is to be done.
!    'GET' requests that the current internal values be returned.
!    'SET' requests that the input parameters overwrite the internal values.
!    'PRINT' prints the current internal values.
!
!    Input/output, real ALPHA, ???
!
!    Input/output, real PLOTXMIN2, PLOTYMIN2, ???
!
!    Input/output, real XMIN, YMIN, minimum X and Y values, below which
!    the data is presumed not to go.
!
  implicit none
!
  character ( len = * ) action
  real alpha
  integer, dimension ( 2 ) :: isave = (/ 0, 0 /)
  integer plotxmin2
  integer plotymin2
  real, dimension ( 3 ) :: rsave = (/ 0.0E+00, 0.0E+00, 0.0E+00 /)
  real xmin
  real ymin
!
  if ( action == 'SET' ) then
    rsave(1) = alpha
    isave(1) = plotxmin2
    isave(2) = plotymin2
    rsave(2) = xmin
    rsave(3) = ymin
  else if ( action == 'GET' ) then
    alpha = rsave(1)
    plotxmin2 = isave(1)
    plotymin2 = isave(2)
    xmin = rsave(2)
    ymin = rsave(3)
  else if ( action == 'PRINT' ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'PS_SETTING:'
    write ( *, '(a)' ) '  Current internal parameters are:'
    write ( *, '(a)' ) ' '
    write ( *, '(a,g14.6)' ) '  ALPHA = ', rsave(1)
    write ( *, '(a,i6)' ) '  PLOTXMIN2 = ', isave(1)
    write ( *, '(a,i6)' ) '  PLOTYMIN2 = ', isave(2)
    write ( *, '(a,g14.6)' ) '  XMIN = ', rsave(2)
    write ( *, '(a,g14.6)' ) '  YMIN = ', rsave(3)
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'PS_SETTING:'
    write ( *, '(a)' ) '  Unrecognized action request.'
  end if

  return
end
subroutine ps_tail ( iunit )
!
!*******************************************************************************
!
!! PS_TAIL writes trailer information to a PostScript file.
!
!
!  Modified:
!
!    26 July 1998
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer IUNIT, the FORTRAN unit to which output should
!    be written.
!
  implicit none
!
  integer iunit
!
  write ( iunit, '(a)' ) 'showpage'
!
!  Write the epilog.
!
  write ( iunit, '(a)' ) 'grestore'
  write ( iunit, '(a)' ) '%%Trailer'
  write ( iunit, '(a)' ) '%%Pages: 1'

  return
end
subroutine timestamp ( )
!
!*******************************************************************************
!
!! TIMESTAMP prints the current YMDHMS date as a time stamp.
!
!
!  Example:
!
!    May 31 2001   9:45:54.872 AM
!
!  Modified:
!
!    31 May 2001
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    None
!
  implicit none
!
  character ( len = 8 ) ampm
  integer d
  character ( len = 8 ) date
  integer h
  integer m
  integer mm
  character ( len = 9 ), parameter, dimension(12) :: month = (/ &
    'January  ', 'February ', 'March    ', 'April    ', &
    'May      ', 'June     ', 'July     ', 'August   ', &
    'September', 'October  ', 'November ', 'December ' /)
  integer n
  integer s
  character ( len = 10 )  time
  integer values(8)
  integer y
  character ( len = 5 ) zone
!
  call date_and_time ( date, time, zone, values )

  y = values(1)
  m = values(2)
  d = values(3)
  h = values(5)
  n = values(6)
  s = values(7)
  mm = values(8)

  if ( h < 12 ) then
    ampm = 'AM'
  else if ( h == 12 ) then
    if ( n == 0 .and. s == 0 ) then
      ampm = 'Noon'
    else
      ampm = 'PM'
    end if
  else
    h = h - 12
    if ( h < 12 ) then
      ampm = 'PM'
    else if ( h == 12 ) then
      if ( n == 0 .and. s == 0 ) then
        ampm = 'Midnight'
      else
        ampm = 'AM'
      end if
    end if
  end if

  write ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
    trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm )

  return
end
subroutine triangular_1 ( n, file_name )
!
!*******************************************************************************
!
!! TRIANGULAR_1 draws a simple triangular grid.
!
!
!  Modified:
!
!    17 July 1999
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer N, specifies the number of grid lines drawn.
!
!    Input, character ( len = * ) FILE_NAME, the name of the file to which the
!    output should be written.
!
  implicit none
!
  character ( len = * ) file_name
  integer i
  integer ierror
  integer iunit
  integer n
  integer pax
  integer pay
  integer pbx
  integer pby
  integer pcx
  integer pcy
  integer px
  integer py
  real xmax
  real xmin
  real ymax
  real ymin
!
!  Open the output file.
!
  iunit = 1

  call ps_create ( file_name, iunit, ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRIANGULAR_1'
    write ( *, '(a,i6)' ) '  File creation error ', ierror
    stop
  end if
!
!  Write the header.
!
  xmin = 0.0E+00
  ymin = 0.0E+00

  xmax = 8.5E+00
  ymax = 11.0E+00

  call ps_head ( file_name, iunit, xmin, xmax, ymin, ymax )
!
!  Draw the grid lines.
!
  pax =  36
  pay = 136

  pbx = 576
  pby = 136

  pcx = 306
  pcy = 568
  
  do i = 0, n

    write ( iunit, '(a)' ) ' newpath'

    px = int ( real ( ( n - i ) * pax + i * pbx ) / real ( n ) )
    py = int ( real ( ( n - i ) * pay + i * pby ) / real ( n ) )
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    px = int ( real ( ( n - i ) * pcx + i * pbx ) / real ( n ) )
    py = int ( real ( ( n - i ) * pcy + i * pby ) / real ( n ) )
    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do

  do i = 0, n

    write ( iunit, '(a)' ) ' newpath'

    px = int ( real ( ( n - i ) * pax + i * pcx ) / real ( n ) )
    py = int ( real ( ( n - i ) * pay + i * pcy ) / real ( n ) )
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    px = int ( real ( ( n - i ) * pbx + i * pcx ) / real ( n ) )
    py = int ( real ( ( n - i ) * pby + i * pcy ) / real ( n ) )
    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do

  do i = 0, n

    write ( iunit, '(a)' ) ' newpath'

    px = int ( real ( ( n - i ) * pbx + i * pax ) / real ( n ) )
    py = int ( real ( ( n - i ) * pby + i * pay ) / real ( n ) )
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    px = int ( real ( ( n - i ) * pcx + i * pax ) / real ( n ) )
    py = int ( real ( ( n - i ) * pcy + i * pay ) / real ( n ) )
    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do
!
!  Write the trailer.
!
  call ps_tail ( iunit )
!
!  Close the output file.
!
  close ( unit = iunit )

  return
end
subroutine uniform_1 ( file_name )
!
!*******************************************************************************
!
!! UNIFORM_1 draws a simple uniform grid at 1/4 inch intervals.
!
!
!  Description:
!
!    The graph paper is surrounded by a half inch blank margin.
!    Lines are drawn every 1/4 inch.
!
!  Modified:
!
!    20 March 1999
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, character ( len = * ) FILE_NAME, the name of the file to which the
!    output should be written.
!
  implicit none
!
  character ( len = * ) file_name
  integer ierror
  integer iunit
  integer px
  integer pxinc
  integer pxmax
  integer pxmin
  integer py
  integer pyinc
  integer pymax
  integer pymin
  real xmax
  real xmin
  real ymax
  real ymin
!
!  Open the output file.
!
  iunit = 1

  call ps_create ( file_name, iunit, ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'UNIFORM_1'
    write ( *, '(a,i6)' ) '  File creation error ', ierror
    stop
  end if
!
!  Write the header.
!
  xmin = 0.0E+00
  ymin = 0.0E+00

  xmax = 8.5E+00
  ymax = 11.0E+00

  call ps_head ( file_name, iunit, xmin, xmax, ymin, ymax )
!
!  Draw the grid lines.
!
  pxmin = 0 + 36
  pxmax = 612 - 36
  pxinc = 18

  pymin = 0 + 36
  pymax = 792 - 36
  pyinc = 18

  do px = pxmin, pxmax, pxinc

    write ( iunit, '(a)' ) ' newpath'
    py = pymin
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    py = pymax

    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do

  do py = pymin, pymax, pyinc

    write ( iunit, '(a)' ) ' newpath'
    px = pxmin
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    px = pxmax

    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do
!
!  Write the trailer.
!
  call ps_tail ( iunit )
!
!  Close the output file.
!
  close ( unit = iunit )

  return
end
subroutine uniform_2 ( file_name )
!
!*******************************************************************************
!
!! UNIFORM_2 draws a uniform grid at 1/4 inch intervals, every fifth line is heavy.
!
!
!  Description:
!
!    The graph paper is surrounded by a half inch blank margin.
!    Lines are drawn every 1/4 inch.
!
!  Modified:
!
!    20 March 1999
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, character ( len = * ) FILE_NAME, the name of the file to which the
!    output should be written.
!
  implicit none
!
  character ( len = * ) file_name
  integer ierror
  integer iunit
  integer px
  integer pxinc
  integer pxmax
  integer pxmin
  integer py
  integer pyinc
  integer pymax
  integer pymin
  integer thick
  integer thin
  real xmax
  real xmin
  real ymax
  real ymin
!
!  Open the output file.
!
  iunit = 1

  call ps_create ( file_name, iunit, ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'UNIFORM_2'
    write ( *, '(a,i6)' ) '  File creation error ', ierror
    stop
  end if
!
!  Write the header.
!
  xmin = 0.0E+00
  ymin = 0.0E+00

  xmax = 8.5E+00
  ymax = 11.0E+00

  call ps_head ( file_name, iunit, xmin, xmax, ymin, ymax )
!
!  Draw the grid lines.
!
  pxmin = 0 + 36
  pxmax = 612 - 36
  pxinc = 18

  pymin = 0 + 36
  pymax = 792 - 36
  pyinc = 18

  thin = 1
  thick = 2

  do px = pxmin, pxmax, pxinc

    if ( mod ( ( px - pxmin ) / pxinc, 5 ) == 0 ) then
      write ( iunit, '(i4,a)' ) thick, ' setlinewidth'
    else if ( mod ( ( px - pxmin ) / pxinc, 5 ) == 1 ) then
      write ( iunit, '(i4,a)' ) thin, ' setlinewidth'
    end if

    write ( iunit, '(a)' ) ' newpath'
    py = pymin
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    py = pymax

    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do

  do py = pymin, pymax, pyinc

    if ( mod ( ( py - pymin ) / pyinc, 5 ) == 0 ) then
      write ( iunit, '(i4,a)' ) thick, ' setlinewidth'
    else if ( mod ( ( py - pymin ) / pyinc, 5 ) == 1 ) then
      write ( iunit, '(i4,a)' ) thin, ' setlinewidth'
    end if

    write ( iunit, '(a)' ) ' newpath'
    px = pxmin
    write ( iunit, '(2i4,a)' ) px, py, ' moveto'

    px = pxmax

    write ( iunit, '(2i4,a)' ) px, py, ' lineto'

    write ( iunit, '(a)' ) ' stroke'

  end do
!
!  Write the trailer.
!
  call ps_tail ( iunit )
!
!  Close the output file.
!
  close ( unit = iunit )

  return
end