program lau_np_prb
!
!*******************************************************************************
!
!! LAU_NP_PRB tests the LAU_NP package.
!
  implicit none
!
  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'LAU_NP_PRB'
  write ( *, '(a)' ) '  Tests for the LAU_NP package.'

  call test01
  call test02
  call test03
  call test04
  call test05
  call test06
  call test07
  call test08
  call test09
  call test10

  call test11
  call test12

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'LAU_NP_PRB'
  write ( *, '(a)' ) '  Normal end of execution.'

  stop
end
subroutine test01
!
!*******************************************************************************
!
!! TEST01 tests GRAPH_ARC_EULER_CIRC.
!
  implicit none
!
  integer, parameter :: nedge = 10
  integer, parameter :: nnode = 5
!
  integer i
  integer, dimension ( nedge ) :: inode = (/ 1, 1, 1, 1, 2, 2, 2, 3, 3, 4 /)
  integer, dimension ( nedge ) :: jnode = (/ 2, 3, 4, 5, 3, 4, 5, 4, 5, 5 /)
  integer, dimension ( nnode ) :: loop
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST01'
  write ( *, '(a)' ) '  For a graph described by an arc list:'
  write ( *, '(a)' ) '  GRAPH_ARC_EULER_CIRC finds an'
  write ( *, '(a)' ) '    Euler circuit of a graph.'
  write ( *, '(a)' ) ' '

  call graph_arc_print ( nedge, inode, jnode, '  The graph:' )

  call graph_arc_euler_circ ( nnode, nedge, inode, jnode, loop )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The nodes in the Euler circuit:'
  write ( *, '(a)' ) ' '

  do i = 1, nnode
    write ( *, '(2i6)' ) i, loop(i)
  end do

  return
end
subroutine test02
!
!*******************************************************************************
!
!! TEST02 tests GRAPH_ARC_MIN_SPAN_TREE.
!
  implicit none
!
  integer, parameter :: nedge = 10
  integer, parameter :: nnode = 5
!
  real, dimension ( nedge ) :: cost = &
    (/ 100., 125., 120., 110., 40., 65., 60., 45., 55., 50. /)
  real, dimension ( nnode-1) :: ctree
  integer, dimension ( nedge ) :: inode = (/ 1, 1, 1, 1, 2, 2, 2, 3, 3, 4 /)
  integer i
  integer itree(nnode-1)
  integer j
  integer, dimension ( nedge ) :: jnode = (/ 2, 3, 4, 5, 3, 4, 5, 4, 5, 5 /)
  integer jtree(nnode-1)
  real tree_cost
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST02'
  write ( *, '(a)' ) '  GRAPH_ARC_MIN_SPAN_TREE finds a minimum '
  write ( *, '(a)' ) '    spanning tree.'
  write ( *, '(a)' ) ' '

  call graph_arc_weight_print ( nedge, inode, jnode, cost, &
    '  The weighted graph:' )

  call graph_arc_min_span_tree ( nnode, nedge, inode, jnode, cost, &
    itree, jtree, tree_cost )

  do i = 1, nnode-1
    ctree(i) = 0.0E+00
    do j = 1, nedge
      if ( ( inode(j) == itree(i) .and. jnode(j) == jtree(i) ) .or. &
           ( inode(j) == jtree(i) .and. jnode(j) == itree(i) ) ) then
        ctree(i) = cost(j)
        exit
      end if
    end do
  end do

  call graph_arc_weight_print ( nnode-1, itree, jtree, ctree, &
    '  The minimal spanning tree:' )

  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  The length of the minimal tree is ', sum ( ctree )

  return
end
subroutine test03
!
!*******************************************************************************
!
!! TEST03 tests GRAPH_DIST_MIN_SPAN_TREE3.
!
  implicit none
!
  integer, parameter :: nnode = 5
  integer, parameter :: lda = nnode
!
  integer class(nnode)
  real dist(lda,nnode)
  integer i
  integer itree(nnode-1)
  integer jtree(nnode-1)
  integer j
  real wtree(nnode-1)
!
  data ( ( dist(i,j), i = 1, nnode ), j = 1, nnode ) / &
       0.0E+00, 100.0E+00, 125.0E+00, 120.0E+00, 110.0E+00, &
     100.0E+00,   0.0E+00,  40.0E+00,  65.0E+00,  60.0E+00, &
     125.0E+00,  40.0E+00,   0.0E+00,  45.0E+00,  55.0E+00, &
     120.0E+00,  65.0E+00,  45.0E+00,   0.0E+00,  50.0E+00, &
     110.0E+00,  60.0E+00,  55.0E+00,  50.0E+00,   0.0E+00 /
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST03'
  write ( *, '(a)' ) '  For a graph defined by a distance matrix,'
  write ( *, '(a)' ) '  GRAPH_DIST_MIN_SPAN_TREE3 finds a minimum spanning tree.'
  write ( *, '(a)' ) ' '
 
  call graph_dist_print ( dist, lda, nnode, '  The graph:' )

  call graph_dist_min_span_tree3 ( lda, nnode, dist, itree, jtree )

  do i = 1, nnode-1
    wtree(i) = dist(itree(i),jtree(i))
  end do

  call graph_arc_weight_print ( nnode-1, itree, jtree, wtree, &
    '  The minimal spanning tree:' )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  The length of the minimal tree is ', sum ( wtree )
 
  return
end
subroutine test04
!
!*******************************************************************************
!
!! TEST04 tests GRAPH_ARC_MIN_PATH.
!
  implicit none
!
  integer, parameter :: nnode = 5
  integer, parameter :: lda = nnode
  integer, parameter :: nedge = 6
!
  real cost(nedge)
  real dist(lda,nnode)
  integer inode(nedge)
  integer i
  integer istart
  integer istop
  integer jnode(nedge)
  integer num_path
  integer path(nnode)
  real path_length
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST04'
  write ( *, '(a)' ) '  GRAPH_ARC_MIN_PATH computes the shortest path from one'
  write ( *, '(a)' ) '  node to another.'
  write ( *, '(a)' ) ' '

  inode(1) = 1
  jnode(1) = 2
  cost(1) = 1.0E+00

  inode(2) = 1
  jnode(2) = 3
  cost(2) = 1.0E+00

  inode(3) = 2
  jnode(3) = 3
  cost(3) = 3.0E+00
 
  inode(4) = 2
  jnode(4) = 5
  cost(4) = 2.0E+00

  inode(5) = 3
  jnode(5) = 4
  cost(5) = 2.0E+00

  inode(6) = 3
  jnode(6) = 5
  cost(6) = 5.0E+00

  call graph_arc_weight_print ( nedge, inode, jnode, cost, &
    '  The weighted graph:' )

  dist(1:nnode,1:nnode) = 0.0E+00

  do istart = 1, nnode
    do istop = istart+1, nnode
      call graph_arc_min_path ( nnode, nedge, inode, jnode, cost, istart, &
        istop, num_path, path, path_length )
      dist(istart,istop) = path_length
      dist(istop,istart) = path_length
    end do
  end do

  call graph_dist_print ( dist, lda, nnode, &
    '  The distance matrix constructed by GRAPH_ARC_MIN_PATH:' )
 
  istart = 4
  istop = 5

  write ( *, '(a)' ) ' '
  write ( *, '(a)') '  The routine actually also computes the path.'
  write ( *, '(a,i6)' ) '  For instance, starting at node ', istart
  write ( *, '(a,i6)' ) '  we compute the shortest path to node ', istop

  call graph_arc_min_path ( nnode, nedge, inode, jnode, cost, istart, &
    istop, num_path, path, path_length )

  write ( *, '(a)' ) ' '

  do i = 1, num_path
    write ( *, '(2i6)' ) i, path(i)
  end do

  return
end
subroutine test05
!
!*******************************************************************************
!
!! TEST05 tests INT_LP
!
  implicit none
!
  integer, parameter :: lda = 4
  integer, parameter :: m = 3
  integer, parameter :: n = 5
!
  real a(lda,n+m+1)
  real, dimension ( m ) :: b = (/ 1.0, -1.0, 4.0 /)
  real, dimension ( n ) :: c = (/ -2.0, 1.0, 4.0, -1.0, -3.0 /)
  integer i
  integer infs
  real x(n)
!
  a(1,1) = - 3.0E+00
  a(1,2) = - 1.0E+00
  a(1,3) =   2.0E+00
  a(1,4) =   3.0E+00
  a(1,5) = - 3.0E+00

  a(2,1) =   0.0E+00
  a(2,2) =   1.0E+00
  a(2,3) = - 1.0E+00
  a(2,4) = - 4.0E+00
  a(2,5) = - 2.0E+00

  a(3,1) =   1.0E+00
  a(3,2) =   0.0E+00
  a(3,3) =   4.0E+00
  a(3,4) =   3.0E+00
  a(3,5) =   0.0E+00

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST05'
  write ( *, '(a)' ) '  INT_LP is a heuristic algorithm for the'
  write ( *, '(a)' ) '  integer linear programming problem.'

  call int_lp ( m, n, a, b, c, lda, x, infs )

  if ( infs == 1 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The problem is infeasible.'
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  COMPUTED SOLUTION:'
    write ( *, '(a)' ) ' '
    write ( *, '(5g12.4)' ) x(1:n)
  end if

  x(1) = 0.0E+00
  x(2) = 2.0E+00
  x(3) = 1.0E+00
  x(4) = 0.0E+00
  x(5) = 1.0E+00

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  CORRECT SOLUTION:'
  write ( *, '(a)' ) ' '
  write ( *, '(5g12.4)' ) x(1:n)

  return
end
subroutine test06
!
!*******************************************************************************
!
!! TEST06 tests MULTI_KNAP.
!
  implicit none
!
  integer, parameter :: m = 3
  integer, parameter :: n = 7
  integer, parameter :: lda = m
!
  real a(lda,n)
  real, dimension ( m ) :: b = (/ 19.0E+00, 14.0E+00, 17.0E+00 /)
  real, dimension ( n ) :: c = (/ &
    31.0E+00, 26.0E+00, 27.0E+00, 29.0E+00, 32.0E+00, 30.0E+00, 28.0E+00 /)
  integer i
  integer isol(n)
  integer numsol
  real objval
!
  a(1,1) =   4.0E+00
  a(1,2) =   5.0E+00
  a(1,3) =   3.0E+00
  a(1,4) =   3.0E+00
  a(1,5) =   7.0E+00
  a(1,6) =   8.0E+00
  a(1,7) =   8.0E+00

  a(2,1) =   3.0E+00
  a(2,2) =   7.0E+00
  a(2,3) =   4.0E+00
  a(2,4) =   9.0E+00
  a(2,5) =   8.0E+00
  a(2,6) =   5.0E+00
  a(2,7) =   6.0E+00

  a(3,1) =   3.0E+00
  a(3,2) =   1.0E+00
  a(3,3) =   2.0E+00
  a(3,4) =   5.0E+00
  a(3,5) =   4.0E+00
  a(3,6) =   4.0E+00
  a(3,7) =   6.0E+00

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST06'
  write ( *, '(a)' ) '  MULTI_KNAP is a heuristic algoritm for the'
  write ( *, '(a)' ) '  multidimensional 0/1 knapsack problem.'

  call multi_knap ( m, n, a, b, c, lda, objval, numsol, isol )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  COMPUTED ANSWERS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The objective function value:'
  write ( *, '(a)' ) ' '
  write ( *, '(g14.6)' ) objval
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The nonzero variables are:'
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) isol(1:numsol)
    
  objval = 88.0E+00
  numsol = 3
  isol(1) = 1
  isol(2) = 3
  isol(3) = 6

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  CORRECT ANSWERS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The objective function value:'
  write ( *, '(a)' ) ' '
  write ( *, '(g14.6)' ) objval
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The nonzero variables are:'
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) isol(1:numsol)

  return
end
subroutine test07
!
!*******************************************************************************
!
!! TEST07 tests KNAPSACK.
!
  implicit none
!
  integer, parameter :: m = 15
  integer, parameter :: n = 7
!
  real, dimension ( n ) :: a = (/ &
    41.0E+00, 50.0E+00, 49.0E+00, 59.0E+00, 55.0E+00, 57.0E+00, 68.0E+00 /)
  real :: b = 170.0E+00
  real, dimension ( n ) :: c = &
    (/ 442.0E+00, 525.0E+00, 511.0E+00, 593.0E+00, 546.0E+00, &
    564.0E+00, 617.0E+00 /)
  real :: eps = 0.8E+00
  integer i
  integer isol(n)
  integer numsol
  real objval
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST07'
  write ( *, '(a)' ) '  KNAPSACK is a heuristic algorithm'
  write ( *, '(a)' ) '  for the 0/1 knapsack problem.'

  call knapsack ( n, a, b, c, eps, m, objval, numsol, isol )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  COMPUTED RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Objective function = '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,g14.6)' ) objval
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Nonzero variables = '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) isol(1:numsol)

  objval = 1652.0E+00
  numsol = 3
  isol(1) = 7
  isol(2) = 4
  isol(3) = 1

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  CORRECT RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Objective function = '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,g14.6)' ) objval
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Nonzero variables = '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) isol(1:numsol)

  return
end
subroutine test08
!
!*******************************************************************************
!
!! TEST08 tests TSP.
!
  implicit none
!
  integer, parameter :: n = 15
  integer, parameter :: lda = n

  real dist(lda,n)
  integer i
  integer i1
  integer i2
  integer isol(n)
  integer j
  real length
!
  data ( ( dist(i,j), j = 1, n ), i = 1, n ) / &
    0., 29., 82., 46., 68., 52., 72., 42., 51., 55., 29., 74., 23., 72., 46., &
   29.,  0., 55., 46., 42., 43., 43., 23., 23., 31., 41., 51., 11., 52., 21., &
   82., 55.,  0., 68., 46., 55., 23., 43., 41., 29., 79., 21., 64., 31., 51., &
   46., 46., 68.,  0., 82., 15., 72., 31., 62., 42., 21., 51., 51., 43., 64., &
   68., 42., 46., 82.,  0., 74., 23., 52., 21., 46., 82., 58., 46., 65., 23., &
   52., 43., 55., 15., 74.,  0., 61., 23., 55., 31., 33., 37., 51., 29., 59., &
   72., 43., 23., 72., 23., 61.,  0., 42., 23., 31., 77., 37., 51., 46., 33., &
   42., 23., 43., 31., 52., 23., 42., 0., 33.,  15., 37., 33., 33., 31., 37., &
   51., 23., 41., 62., 21., 55., 23., 33.,  0., 29., 62., 46., 29., 51., 11., &
   55., 31., 29., 42., 46., 31., 31., 15., 29.,  0., 51., 21., 41., 23., 37., &
   29., 41., 79., 21., 82., 33., 77., 37., 62., 51.,  0., 65., 42., 59., 61., &
   74., 51., 21., 51., 58., 37., 37., 33., 46., 21., 65.,  0., 61., 11., 55., &
   23., 11., 64., 51., 46., 51., 51., 33., 29., 41., 42., 61.,  0., 62., 23., &
   72., 52., 31., 43., 65., 29., 46., 31., 51., 23., 59., 11., 62.,  0., 59., &
   46., 21., 51., 64., 23., 59., 33., 37., 11., 37., 61., 55., 23., 59.,  0. /

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST08'
  write ( *, '(a)' ) '  TSP is a heuristic algorithm'
  write ( *, '(a)' ) '  for the traveling salesman problem.'

  call tsp ( n, dist, lda, isol )

  length = 0.0
  do i = 1, n
    i1 = isol(i)
    if ( i < n ) then
      i2 = isol(i+1)
    else
      i2 = isol(1)
    end if
    length = length + dist(i1,i2)
  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'COMPUTED RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(20i3)' ) isol(1:n)
  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  Path length = ', length

  isol( 1) =  1
  isol( 2) = 13
  isol( 3) =  2
  isol( 4) = 15
  isol( 5) =  9
  isol( 6) =  5
  isol( 7) =  7
  isol( 8) =  3
  isol( 9) = 12
  isol(10) = 14
  isol(11) = 10
  isol(12) =  8
  isol(13) =  6
  isol(14) =  4
  isol(15) = 11

  length = 0.0E+00
  do i = 1, n
    i1 = isol(i)
    if ( i < n ) then
      i2 = isol(i+1)
    else
      i2 = isol(1)
    end if
    length = length + dist(i1,i2)
  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'CORRECT RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(20i3)' ) isol(1:n)
  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  Path length = ', length

  return
end
subroutine test09
!
!*******************************************************************************
!
!! TEST09 tests STEINER.
!
  implicit none
!
  integer, parameter :: m = 20
  integer, parameter :: n = 10
  integer, parameter :: ns = 5
!
  real arcost(m)
  integer i
  integer inode(m)
  integer istree(n)
  integer jnode(m)
  integer jstree(n)
  integer nsp
  logical spoint(n)
  real xlen
!
  inode(1) = 2
  inode(2) = 3
  inode(3) = 8
  inode(4) = 10
  inode(5) = 4
  inode(6) = 3
  inode(7) = 7
  inode(8) = 8
  inode(9) = 9
  inode(10) = 10
  inode(11) = 4
  inode(12) = 7
  inode(13) = 9
  inode(14) = 5
  inode(15) = 10
  inode(16) = 5
  inode(17) = 7
  inode(18) = 5
  inode(19) = 7
  inode(20) = 9

  jnode(1) = 1
  jnode(2) = 2
  jnode(3) = 3
  jnode(4) = 6
  jnode(5) = 2
  jnode(6) = 4
  jnode(7) = 3
  jnode(8) = 7
  jnode(9) = 8
  jnode(10) = 9
  jnode(11) = 1
  jnode(12) = 4
  jnode(13) = 7
  jnode(14) = 1
  jnode(15) = 5
  jnode(16) = 4
  jnode(17) = 5
  jnode(18) = 6
  jnode(19) = 6
  jnode(20) = 6

  arcost(1) = 6.0E+00
  arcost(2) = 2.0E+00
  arcost(3) = 6.0E+00
  arcost(4) = 9.0E+00
  arcost(5) = 3.0E+00
  arcost(6) = 4.0E+00
  arcost(7) = 5.0E+00
  arcost(8) = 9.0E+00
  arcost(9) = 3.0E+00
  arcost(10) = 4.0E+00
  arcost(11) = 3.0E+00
  arcost(12) = 2.0E+00
  arcost(13) = 3.0E+00
  arcost(14) = 5.0E+00
  arcost(15) = 8.0E+00
  arcost(16) = 6.0E+00
  arcost(17) = 7.0E+00
  arcost(18) = 4.0E+00
  arcost(19) = 4.0E+00
  arcost(20) = 8.0E+00

  spoint(1:n) = .false.

  spoint(3) = .true.
  spoint(1) = .true.
  spoint(10) = .true.
  spoint(6) = .true.
  spoint(9) = .true.

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST09'
  write ( *, '(a)' ) '  STEINER is a heuristic algorithm'
  write ( *, '(a)' ) '  for the Steiner tree problem.'

  call steiner ( n, m, inode, jnode, arcost, ns, spoint, nsp, &
    istree, jstree, xlen )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'COMPUTED RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Steiner tree edges:'
  write ( *, '(a)' ) ' '
  do i = 1, nsp
    write ( *, '(4x,2i3)' ) istree(i), jstree(i)
  end do
  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  Total length = ', xlen

  nsp = 6
  istree(1) = 3
  jstree(1) = 4
  istree(2) = 4
  jstree(2) = 7
  istree(3) = 4
  jstree(3) = 1
  istree(4) = 7
  jstree(4) = 9
  istree(5) = 7
  jstree(5) = 6
  istree(6) = 9
  jstree(6) = 10
  xlen = 20.0E+00

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'CORRECT RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Steiner tree edges:'
  write ( *, '(a)' ) ' '
  do i = 1, nsp
    write ( *, '(4x,2i3)' ) istree(i), jstree(i)
  end do
  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  Total length = ', xlen

  return
end
subroutine test10
!
!*******************************************************************************
!
!! TEST10 tests PARTITION.
!
  implicit none
!
  integer, parameter :: n = 5
  integer, parameter :: lda = 2 * n
!
  real cost(lda,2*n)
  integer i
  logical init
  integer ip(n)
  integer iq(n)
  integer j
  integer kp(n)
  integer kq(n)
  real tcost
!
  data ( ( cost(i,j), j = 1, 2*n ), i = 1, 2*n ) / &
    0.0, 2.0, 4.0, 7.0, 4.0, 0.0, 0.0, 0.0, 5.0, 1.0, &
    2.0, 0.0, 3.0, 6.0, 3.0, 1.0, 1.0, 0.0, 1.0, 5.0, &
    4.0, 3.0, 0.0, 1.0, 2.0, 1.0, 0.0, 1.0, 0.0, 0.0, &
    7.0, 6.0, 1.0, 0.0, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0, &
    4.0, 3.0, 2.0, 0.0, 0.0, 0.0, 1.0, 2.0, 0.0, 4.0, &
    0.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 1.0, &
    0.0, 1.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 3.0, &
    0.0, 0.0, 1.0, 1.0, 2.0, 1.0, 0.0, 0.0, 1.0, 1.0, &
    5.0, 1.0, 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 0.0, 1.0, &
    1.0, 5.0, 0.0, 1.0, 4.0, 1.0, 3.0, 1.0, 1.0, 0.0 /

  init = .true.

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST10'
  write ( *, '(a)' ) '  PARTITION is a heuristic algorithm'
  write ( *, '(a)' ) '  for the graph partition problem.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The order of the sets, and of the items in the set,'
  write ( *, '(a)' ) '  does not matter.'

  call partition ( n, cost, lda, init, ip, iq, kp, kq, tcost )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'COMPUTED RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  First set:'
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) kp(1:n)
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Second set:'
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) kq(1:n)
  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  Total cost = ', tcost
 
  tcost = 25.0E+00

  kp(1) = 9
  kp(2) = 3
  kp(3) = 1
  kp(4) = 4
  kp(5) = 2

  kq(1) = 5
  kq(2) = 10
  kq(3) = 7
  kq(4) = 6
  kq(5) = 8

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'CORRECT RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  First set:'
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) kp(1:n)
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Second set:'
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) kq(1:n)
  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  Total cost = ', tcost

  return
end
subroutine test11
!
!*******************************************************************************
!
!! TEST11 tests K_MEDIAN.
!
  implicit none
!
  integer, parameter :: m = 10
  integer, parameter :: n = 15

  integer, parameter :: lda = m
!
  real c(lda,n)
  integer i
  integer isol(m)
  integer j
  integer k
!
  data ( ( c(i,j), j = 1, n ), i = 1, m ) / &
    2.0, 3.0, 0.0, 6.0, 5.0, 2.0, 3.0, 2.0, 4.0, 9.0, 2.0, 0.0, 8.0, 7.0, 3.0, &
    4.0, 8.0, 6.0, 0.0, 8.0, 1.0, 3.0, 3.0, 4.0, 1.0, 1.0, 9.0, 3.0, 8.0, 3.0, &
    0.0, 8.0, 4.0, 6.0, 2.0, 3.0, 2.0, 6.0, 6.0, 6.0, 5.0, 7.0, 9.0, 9.0, 0.0, &
    9.0, 7.0, 2.0, 6.0, 4.0, 2.0, 1.0, 5.0, 9.0, 0.0, 7.0, 1.0, 1.0, 4.0, 2.0, &
    7.0, 4.0, 5.0, 3.0, 3.0, 4.0, 5.0, 0.0, 3.0, 4.0, 3.0, 3.0, 8.0, 4.0, 9.0, &
    6.0, 1.0, 1.0, 7.0, 7.0, 9.0, 7.0, 4.0, 6.0, 7.0, 2.0, 2.0, 1.0, 5.0, 0.0, &
    7.0, 4.0, 0.0, 7.0, 7.0, 4.0, 3.0, 2.0, 4.0, 3.0, 9.0, 5.0, 1.0, 8.0, 5.0, &
    5.0, 1.0, 5.0, 7.0, 0.0, 8.0, 4.0, 6.0, 5.0, 6.0, 4.0, 3.0, 5.0, 2.0, 1.0, &
    1.0, 2.0, 5.0, 2.0, 4.0, 7.0, 4.0, 7.0, 0.0, 9.0, 7.0, 5.0, 2.0, 1.0, 7.0, &
    7.0, 9.0, 0.0, 0.0, 6.0, 3.0, 0.0, 8.0, 3.0, 9.0, 1.0, 7.0, 1.0, 6.0, 5.0 /
!
  k = 4

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST11'
  write ( *, '(a)' ) '  K_MEDIAN is a heuristic algorithm'
  write ( *, '(a)' ) '  for the K median problem.'

  call k_median ( m, n, c, k, lda, isol )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'COMPUTED RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The K rows found: '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) isol(1:k)

  isol(1) = 5
  isol(2) = 2
  isol(3) = 6
  isol(4) = 4

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'CORRECT RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The K rows found: '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) isol(1:k)

  return
end
subroutine test12
!
!*******************************************************************************
!
!! TEST12 tests K_CENTER.
!
  implicit none
!
  integer, parameter :: nnode = 10
  integer, parameter :: lda = nnode
  integer, parameter :: m = ( nnode * ( nnode - 1 ) ) / 2
!
  real cost(lda,nnode)
  integer i
  integer j
  integer kmax
  integer knum
  integer kset(nnode)
!
  data ( ( cost(i,j), j = 1, nnode ), i = 1, nnode ) / &
     0.0, 15.0, 72.0, 51.0, 50.0, 59.0, 53.0, 68.0, 11.0, 33.0, &
    15.0,  0.0, 66.0, 44.0, 43.0, 45.0, 56.0, 65.0,  9.0, 35.0, &
    72.0, 66.0,  0.0,104.0, 23.0, 77.0, 38.0, 11.0, 62.0, 44.0, &
    51.0, 44.0,104.0,  0.0, 82.0, 41.0, 99.0,106.0, 52.0, 79.0, &
    50.0, 43.0, 23.0, 82.0,  0.0, 59.0, 26.0, 25.0, 39.0, 28.0, &
    59.0, 45.0, 77.0, 41.0, 59.0,  0.0, 82.0, 83.0, 52.0, 70.0, &
    53.0, 56.0, 38.0, 99.0, 26.0, 82.0,  0.0, 28.0, 47.0, 21.0, &
    68.0, 65.0, 11.0,106.0, 25.0, 83.0, 28.0,  0.0, 59.0, 37.0, &
    11.0,  9.0, 62.0, 52.0, 39.0, 52.0, 47.0, 59.0,  0.0, 27.0, &
    33.0, 35.0, 44.0, 79.0, 28.0, 70.0, 21.0, 37.0, 27.0,  0.0 /
!
  kmax = 4

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST12'
  write ( *, '(a)' ) '  K_CENTER is a heuristic algorithm'
  write ( *, '(a)' ) '  for the K center problem.'

  call k_center ( nnode, cost, kmax, lda, knum, kset )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'COMPUTED RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The centers: '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) kset(1:knum)

  knum = 4
  kset(1) = 9
  kset(2) = 5
  kset(3) = 4
  kset(4) = 6

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'CORRECT RESULTS:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The centers: '
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) kset(1:knum)

  return
end