program laupack_prb
!
!*******************************************************************************
!
!! LAUPACK_PRB calls the LAUPACK test routines.
!
  implicit none
!
  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'LAUPACK_PRB'
  write ( *, '(a)' ) '  Tests for the LAUPACK graph routines.'
 
  call test01
  call test22
  call test02
  call test03
  call test04
  call test05
  call test06
  call test07
  call test08
  call test09
  call test10

  call test11
  call test12
  call test13
  call test14
  call test15
  call test16
  call test17
  call test18
  call test19
  call test20

  call test21
  call test22
  call test23
  call test24

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

  stop
end
subroutine test01
!
!*******************************************************************************
!
!! TEST01 calls DIGRAPH_ARC_EULER.
!
  implicit none
!
  integer, parameter :: nedge = 7
  integer, parameter :: nnode = 5
!
  integer i
  integer in
  integer, dimension ( nedge ) :: inode = (/ 2, 1, 2, 1, 3, 5, 4 /)
  integer j
  integer, dimension ( nedge ) :: jnode = (/ 5, 4, 3, 2, 1, 1, 2 /)
  integer jp1
  logical success
  integer trail(nedge)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST01'
  write ( *, '(a)' ) '  DIGRAPH_ARC_EULER finds an Euler circuit of a digraph.'

  call digraph_arc_print ( nedge, inode, jnode, &
    '  The arc list of the digraph:' )

  call digraph_arc_euler ( nnode, nedge, inode, jnode, success, trail )

  if ( success ) then

    call ivec_print ( nedge, trail, '  The edge list of the Euler circuit:' )

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The node list of the Euler circuit:'
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '    I  Edge  Node'
    write ( *, '(a)' ) ' '

    do i = 1, nedge

      j = trail(i)

      if ( i == nedge ) then
        jp1 = trail(1)
      else
        jp1 = trail(i+1)
      end if

      if ( jnode(j) == inode(jp1) ) then
        in = jnode(j)
      else
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'The circuit has failed!'
        exit
      end if

      write ( *, '(3i6)' ) i, j, in

    end do

  else

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The digraph is not eulerian.'
    write ( *, '(a)' ) ' '

  end if

  return
end
subroutine test02
!
!*******************************************************************************
!
!! TEST02 calls DIGRAPH_ARC_GET_PATH.
!! TEST02 calls DIGRAPH_ARC_KSHORT2.
!
  implicit none
!
  integer, parameter :: kpaths = 4
  integer, parameter :: nedge = 11
  integer, parameter :: nnode = 6

  integer, parameter :: maxque = 2 * kpaths
!
  integer arcbwd(nnode)
  integer arcdir(nnode)
  integer arcfwd(nnode)
  integer, dimension ( nedge ) :: arclen = (/ &
    1, 3, 2, 3, 3, 6,-2, 2, 2, 4, 2 /)
  integer arcnod(nnode)
  integer auxdis(nnode)
  integer auxlnk(nnode)
  integer auxstg(nnode)
  integer auxtre(nnode)
  integer crosar(maxque)
  integer i
  integer iflag
  integer, dimension ( nedge ) :: inode = &
    (/ 4, 3, 6, 4, 2, 5, 6, 5, 1, 2, 4 /)
  integer ipaths
  integer isink
  integer isorce
  integer j
  integer, dimension ( nedge ) :: jnode = &
    (/ 2, 1, 5, 3, 1, 4, 1, 2, 3, 6, 1 /)
  integer k
  integer length
  integer nextrd(maxque)
  integer nump
  integer nxtbwd(nedge)
  integer nxtfwd(nedge)
  integer pathlen(nnode+1)
  integer qufirp(kpaths+3)
  integer qunxtp(kpaths+3)
  integer trdist(nnode)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST02'
  write ( *, '(a)' ) '  DIGRAPH_ARC_KSHORT2 finds the K shortest paths without'
  write ( *, '(a)' ) '    repetition;'
  write ( *, '(a)' ) '  DIGRAPH_ARC_GET_PATH retrieves the computed paths.'

  call digraph_arc_print ( nedge, inode, jnode, &
    '  The arc list of the digraph:' )

  isorce = 5
  isink = 3
!
!  Find the shortest path lengths.
!
  call digraph_arc_kshort2 ( nnode, nedge, inode, jnode, arclen, kpaths, &
    maxque, isorce, isink, iflag, ipaths, pathlen, arcdir, trdist, arcnod, &
    arcfwd, arcbwd, auxstg, auxdis, auxtre, auxlnk, nxtfwd, nxtbwd, qufirp, &
    qunxtp, crosar, nextrd )

  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  IFLAG = ', iflag
  write ( *, '(a,i6,a)' ) '  The first ', ipaths, ' shortest paths '
  write ( *, '(a,i6,a,i6)' ) '  from ', isorce, ' to ', isink
  write ( *, '(a)' ) '  These path lengths are:'
  write ( *, '(a)' ) ' '

  do i = 2, ipaths + 1
    write ( *, '(i6)' ) pathlen(i)
  end do    
!
!  Output the paths
!
  do k = 1, ipaths

    call digraph_arc_get_path ( nnode, nedge, k, kpaths, maxque, inode, jnode, &
      pathlen, arcdir, qufirp, qunxtp, crosar, nextrd, nump, length, arcnod )

    write ( *, '(a)' ) ' '
    write ( *, '(a,i6,a,i6,a)' ) '  Path ', k, ' has ', nump, ' edges,'
    write ( *, '(a,i6)' ) '  and a length of ', length
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The edges in the path:'
    write ( *, '(a)' ) ' '
    write ( *, '(10i6)' ) arcnod(1:nump)
   
  end do
   
  return
end
subroutine test03
!
!*******************************************************************************
!
!! TEST03 tests DIGRAPH_ARC_HAMCYC.
!
  implicit none
!
  integer, parameter :: nedge = 16
  integer, parameter :: nnode = 10
!
  integer hcycle(nnode)
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 6, 5,  8, 5, 4, 1, 10, 7, 9, 2, 7, 3, 9, 3, 10, 6 /)
  integer, dimension ( nedge ) :: jnode = &
    (/ 2, 3, 10, 2, 9, 8,  5, 4, 5, 4, 1, 8, 7, 7,  6, 1 /)
  logical success
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST03'
  write ( *, '(a)' ) '  DIGRAPH_ARC_HAMCYC finds a hamiltonian circuit.'

  call digraph_arc_print ( nedge, inode, jnode, &
    '  The arc list of the digraph:' )
 
  call digraph_arc_hamcyc ( nnode, nedge, inode, jnode, success, hcycle )

  if ( success ) then

    call ivec_print ( nnode, hcycle, '  The Hamiltonian circuit:' )

  else

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The digraph is not hamiltonian.'

  end if

  return
end
subroutine test04
!
!*******************************************************************************
!
!! TEST04 calls DIGRAPH_ARC_KSHORT1.
!! TEST04 calls DIGRAPH_ARC_PRT_PATH.
!
  implicit none
!
  integer, parameter :: k = 4
  integer, parameter :: nedge = 14
  integer, parameter :: nnode = 6
  integer, parameter :: npmax = 20
!
  real, dimension ( nedge ) :: arclen = &
    (/ 2.0,-2.0, 3.0,-3.0, 4.0, 6.0, 4.0, 4.0,-3.0, 9.0, 6.0, 4.0, 4.0, 2.0 /)
  real dist(nnode,k)
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 6, 3, 4, 5, 6, 2, 2, 2, 1, 4, 1, 3, 2, 4 /)
  integer isink
  integer :: isorce = 2
  integer iter
  integer j
  integer, dimension ( nedge ) :: jnode = &
    (/ 1, 1, 2, 3, 3, 3, 3, 4, 4, 5, 5, 5, 6, 6 /)
  integer maxpath
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST04'
  write ( *, '(a)' ) '  DIGRAPH_ARC_KSHORT1 computes the K shortest path'
  write ( *, '(a)' ) '    lengths from a given node to all others,'
  write ( *, '(a)' ) '  DIGRAPH_ARC_PRT_PATH prints them out.'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  Input K = ', k
  write ( *, '(a,i6)' ) '  Starting node ', isorce

  call digraph_arc_weight_print ( nedge, inode, jnode, arclen, &
    '  The arc list of the weighted digraph:' )

  iter = 0
    
  call digraph_arc_kshort1 ( nnode, nedge, k, isorce, iter, inode, jnode, &
    arclen, dist )
     
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  Total number of iterations = ', iter
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Distance array.'
  write ( *, '(a)') ' '

  do i = 1, nnode
    write ( *, '(4x,i6,4g14.6)' ) i, dist(i,1:k)
  end do
!
!  Generate at most 10 of the shortest paths from ISORCE to ISINK.
!      
  isink = 5
  maxpath = 10

  call digraph_arc_prt_path ( nnode, nedge, npmax, k, maxpath, isorce, &
    isink, inode, jnode, arclen, dist )
   
  return
end
subroutine test05
!
!*******************************************************************************
!
!! TEST05 tests DIGRAPH_ARC_MINEQV.
!
  implicit none
!
  integer, parameter :: nedge = 10
  integer, parameter :: nnode = 5
!
  logical arclis(nedge)
  integer i
  integer, dimension ( nedge ) :: inode = (/ 5,2,2,4,1,3,1,5,1,3 /)
  integer, dimension ( nedge ) :: inode2
  integer, dimension ( nedge ) :: jnode = (/ 2,3,4,5,5,4,2,3,4,1 /)
  integer, dimension ( nedge ) :: jnode2
  integer nedge2
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST05'
  write ( *, '(a)' ) '  DIGRAPH_ARC_MINEQV finds the minimal equivalent'
  write ( *, '(a)' ) '  digraph.'

  call digraph_arc_print ( nedge, inode, jnode, &
    '  The arc list of the digraph:' )

  call digraph_arc_mineqv ( nnode, nedge, inode, jnode, arclis )

  nedge2 = 0

  do i = 1, nedge

    if ( arclis(i) ) then
      nedge2 = nedge2 + 1
      inode2(nedge2) = inode(i)
      jnode2(nedge2) = jnode(i)
    end if

  end do

  call digraph_arc_print ( nedge2, inode2, jnode2, &
    '  The arc list of the minimal equivalent digraph:' )

  nedge2 = 6
  inode2(1) = 5
  jnode2(1) = 2
  inode2(2) = 2
  jnode2(2) = 3
  inode2(3) = 4
  jnode2(3) = 5
  inode2(4) = 1
  jnode2(4) = 5
  inode2(5) = 3
  jnode2(5) = 4
  inode2(6) = 3
  jnode2(6) = 1
 
  call digraph_arc_print ( nedge2, inode2, jnode2, &
    '  The arc list of the correct answer:' )

  return
end
subroutine test06
!
!*******************************************************************************
!
!! TEST06 tests DIGRAPH_ARC_NFLOW
!
  implicit none
!
  integer, parameter :: nnode = 6
  integer, parameter :: nedge = 20
!
  integer, dimension ( nedge ) :: capac = &
    (/ 3, 7, 2, 5, 4, 1, 4, 2, 8, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /)
  integer, dimension ( nedge ) :: flow
  integer, dimension ( nedge ) :: inode = &
    (/ 1, 1, 2, 2, 2, 3, 3, 4, 4, 5, 2, 3, 3, 4, 5, 4, 5, 5, 6, 6 /)
  integer :: isink = 6
  integer :: isorce = 1
  integer j
  integer, dimension ( nedge ) :: jnode = &
    (/ 2, 3, 3, 4, 5, 4, 5, 5, 6, 6, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5 /)
  integer mincut(nnode)
  integer, dimension ( nnode ) :: nodflow
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST06'
  write ( *, '(a)' ) '  DIGRAPH_ARC_NFLOW finds the maximum flow '
  write ( *, '(a)' ) '    on a network'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The source is node ', isorce
  write ( *, '(a,i6)' ) '  The sink is node   ', isink

  call digraph_arc_print ( nedge, inode, jnode, &
    '  The edge list of the digraph:' )

  call ivec_print ( nedge, capac, '  The edge capacities:' )

  call digraph_arc_nflow ( nnode, nedge, inode, jnode, capac, isorce, &
    isink, mincut, flow, nodflow )

  call ivec_print ( nnode, mincut, '  0/1 node cutset array:' )

  call ivec_print ( nedge, flow, '  Edge flows:' )

  call ivec_print ( nnode, nodflow, '  Node flows:' )

  return
end
subroutine test07
!
!*******************************************************************************
!
!! TEST07 tests DIGRAPH_ARC_SHTREE.
!
  implicit none
!
  integer, parameter :: nedge = 11
  integer, parameter :: nnode = 6
!
  real, dimension ( nedge ) :: arclen = &
    (/ 3.0, 4.0, 2.0, 4.0, -2.0, -1.0, 5.0, 2.0, 7.0, 6.0, 9.0 /)
  real dist(nnode)
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/  3,  2,  5,  4,  1,  1,  6,  6,  1,  3,  6 /)
  integer :: iroot = 3
  integer, dimension ( nnode - 1 ) :: itree
  integer j
  integer, dimension ( nedge ) :: jnode = &
    (/  6,  5,  4,  2,  4,  5,  4,  1,  3,  5,  2 /)
  integer, dimension ( nnode - 1 ) :: jtree
  real, dimension ( nnode - 1 ) :: wtree
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST07'
  write ( *, '(a)' ) '  DIGRAPH_ARC_SHTREE constructs a tree of the shortest'
  write ( *, '(a)' ) '  paths from one node to all others.'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The base node will be ', iroot

  call digraph_arc_weight_print ( nedge, inode, jnode, arclen, &
    '  The weighted arc list of the digraph:' )

  call digraph_arc_shtree ( nnode, nedge, iroot, inode, jnode, arclen, dist, &
    itree, jtree )
   
  call rvec_print ( nnode, dist, '  Distance from base node to other nodes:' )
   
  do i = 1, nnode-1
    wtree(i) = 0.0
    do j = 1, nedge
      if ( inode(j) == itree(i) .and. jnode(j) == jtree(i) ) then
        wtree(i) = arclen(j)
      end if
    end do
  end do

  call digraph_arc_weight_print ( nnode-1, itree, jtree, wtree, &
    '  The weighted arc list of the shortest path tree:' )

  return
end
subroutine test08
!
!*******************************************************************************
!
!! TEST08 tests DIGRAPH_ARC_STCOMP.
!
!  Find the strongly connected components of the following digraph:
!
!
!  1--><--9-->--4
!
!  5--<--7-->--2--<--8--><--10-->--3-->---6
!    \   |    /                     \    /
!     V  A  V                        A  V
!       \|/                           \/
!        12                           11
!
  implicit none
!
  integer, parameter :: nedge = 15
  integer, parameter :: nnode = 12
!
  integer, dimension ( nnode ) :: comp
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 8,11, 9, 5, 3, 8, 9, 6,12,10, 7, 1, 2,10, 7 /)
  integer j
  integer, dimension ( nedge ) :: jnode = &
    (/ 2, 3, 1,12, 6,10, 4,11, 7, 3, 2, 9,12, 8, 5 /)
  integer k
  integer numcomp
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST08'
  write ( *, '(a)' ) '  DIGRAPH_ARC_STCOMP finds the strongly connected'
  write ( *, '(a)' ) '    components of a directed graph.'

  call digraph_arc_print ( nedge, inode, jnode, &
    '  The arc list of the digraph:' )

  call digraph_arc_stcomp ( nnode, nedge, inode, jnode, numcomp, comp )

  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  Number of strong components = ', numcomp

  call ivec_print ( nnode, comp, '  The component of each node:' )

  return
end
subroutine test09
!
!*******************************************************************************
!
!! TEST09 calls DIGRAPH_DIST_ALLPATH.
!
  implicit none
!
  integer, parameter :: nnode = 6
  integer, parameter :: lda = nnode
!
  real dist(lda,nnode)
  integer i
  integer j
  integer next(nnode,nnode)
  integer node
  integer node1
  integer node2
  integer num
  integer path(nnode)
!
  data dist / &
     0.0,  3.0,  2.0, 99.0, 99.0,  1.0, &
     3.0,  0.0,  8.0, 99.0,  2.0,  2.0, &
    99.0,  8.0,  0.0,  2.0, 99.0, 99.0, &
    99.0, 99.0,  2.0,  0.0,  8.0,  1.0, &
    99.0,  2.0, 99.0,  8.0,  0.0,  9.0, &
     1.0, 99.0, 99.0,  1.0,  9.0,  0.0 /
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST09'
  write ( *, '(a)' ) '  DIGRAPH_DIST_ALLPATH computes the shortest distance '
  write ( *, '(a)' ) '  between all pairs of nodes.'

  call digraph_dist_print ( dist, lda, nnode, '  The distance matrix:' )

  call digraph_dist_allpath ( nnode, dist, lda, next )
!
!  Store the shortest path from node 3 to node 5 in PATH.
!      
  node1 = 3
  node2 = 5
  j = node1
  num = 1

  path(num) = node1

  do

    node = next(node2,j)
    num = num + 1
    path(num) = node

    if ( node == node2 ) then
      exit
    end if

    j = node

  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The shortest path from '
  write ( *, '(i6,a,i6)' ) node1, ' to ', node2
  write ( *, '(a)' ) ' '
  write ( *, '(4x,20i3)' ) path(1:num)

  return
end
subroutine test10
!
!*******************************************************************************
!
!! TEST10 tests DIGRAPH_DIST_SHORTP.
!
  implicit none
!
  integer, parameter :: nnode = 6
  integer, parameter :: lda = nnode
!
  real dist(lda,nnode)
  integer i
  integer :: isink = 2
  integer :: isorce = 3
  integer j
  real lnpath
  integer numnod
  integer path(nnode)
!
  data ( ( dist(i,j), i = 1, nnode ), j = 1, nnode ) / &
       0.0, 99.0, 99.0, 99.0, 99.0,  2.0, &
      99.0,  0.0, 99.0,  4.0, 99.0,  9.0, &
       7.0, 99.0,  0.0, 99.0, 99.0, 99.0, &
       2.0, 99.0, 99.0,  0.0,  2.0,  5.0, &
       1.0,  4.0,  6.0, 99.0,  0.0, 99.0, & 
      99.0, 99.0,  3.0, 99.0, 99.0,  0.0 /
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST10'
  write ( *, '(a)' ) '  DIGRAPH_DIST_SHORTP finds the shortest path between '
  write ( *, '(a)' ) '    two nodes.'
  write ( *, '(a,i6)' ) '  Start node is  ', isorce
  write ( *, '(a,i6)' ) '  Finish node is ', isink

  call digraph_dist_print ( dist, lda, nnode, '  The distance matrix:' )

  call digraph_dist_shortp ( nnode, dist, lda, isorce, isink, numnod, path, &
    lnpath )

  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  The path length is ', lnpath

  call ivec_print ( numnod, path, '  The shortest path:' )
   
  return
end
subroutine test11
!
!*******************************************************************************
!
!! TEST11 calls DIGRAPH_DIST_SHORT_LN.
!
  implicit none
!
  integer, parameter :: nnode = 6
  integer, parameter :: lda = nnode
!
  real dist(lda,nnode)
  integer i
  integer j
  integer :: root = 5
  real shdist(nnode)
!
  data dist / &
     0.0,  3.0,  2.0, 99.0, 99.0,  1.0, &
     3.0,  0.0,  8.0, 99.0,  2.0,  2.0, &
    99.0,  8.0,  0.0,  2.0, 99.0, 99.0, &
    99.0, 99.0,  2.0,  0.0,  8.0,  1.0, &
    99.0,  2.0, 99.0,  8.0,  0.0,  9.0, &
     1.0, 99.0, 99.0,  1.0,  9.0,  0.0 /
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST11'
  write ( *, '(a)' ) '  DIGRAPH_DIST_SHORT_LN finds shortest paths from one'
  write ( *, '(a)' ) '    node to all others.'
  write ( *, '(a,i6)' ) '  The root node will be ', root

  call digraph_dist_print ( dist, lda, nnode, '  The distance matrix:' )

  call digraph_dist_short_ln ( nnode, dist, lda, root, shdist )

  call rvec_print ( nnode, shdist, '  Root-to-Node distances:' )

  return
end
subroutine test12
!
!*******************************************************************************
!
!! TEST12 tests GRAPH_ARC_CLIQUE.
!
  implicit none
!
  integer, parameter :: nedge = 11
  integer, parameter :: nnode = 9
!
  integer i
  integer, dimension ( nedge ) :: inode = (/ 5, 1, 3, 6, 2, 5, 5, 1, 2, 7, 8 /)
  integer, dimension ( nedge ) :: jnode = (/ 8, 9, 9, 9, 7, 2, 7, 3, 8, 8, 4 /)
  integer cliq(nnode)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST12'
  write ( *, '(a)' ) '  GRAPH_ARC_CLIQUE finds cliques in a graph.'

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )

  call graph_arc_clique ( nnode, nedge, inode, jnode, cliq )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The correct answer is :'
  write ( *, '(a)' ) '    (8,2,5,7), (8,4), (3,1,9), (6,9).'

  return
end
subroutine test13
!
!*******************************************************************************
!
!! TEST13 tests GRAPH_ARC_COLOR_NUMBER.
!
!  Here is the graph to be colored.
!
!    6----8----3    7---11
!    |\  / \  /|    |    |
!    | \/   \/ |    |    |
!    | 1----2  |   10----5
!    | |    |  |
!    \ |    | /
!     \|    |/
!      4----9
!
!
  implicit none
!
  integer, parameter :: nedge = 16
  integer, parameter :: nnode = 11
!
  integer color(nnode)          
  integer i           
  integer, dimension ( nedge ) :: inode = &
    (/ 3, 6, 7,1,4,10,2,6,8, 5,8,10,1,3,2,9 /)
  integer, dimension ( nedge ) :: jnode = &
    (/ 9, 8,11,2,1, 7,8,4,3,11,1, 5,6,2,9,4 /)
  integer ncolor 
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST13'
  write ( *, '(a)' ) '  GRAPH_ARC_COLOR_NUMBER finds the chromatic number of a'
  write ( *, '(a)' ) '  graph and exhibits a corresponding node coloring.'

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )

  call graph_arc_color_number ( nnode, nedge, inode, jnode, ncolor, color )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Computed answers:'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The chromatic number of the graph, that is,'
  write ( *, '(a,i6)' ) '  the number of colors required for the nodes = ', &
    ncolor

  call graph_arc_ncolor_print ( nedge, inode, jnode, nnode, color, &
    '  The arc list and node colors of the graph:' )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Correct answers:'

  ncolor = 4
  color = (/ 1, 2, 1, 2, 1, 3, 1, 4, 3, 2, 2 /)

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The chromatic number of the graph, that is,'
  write ( *, '(a,i6)' ) '  the number of colors required for the nodes = ', &
    ncolor

  call graph_arc_ncolor_print ( nedge, inode, jnode, nnode, color, &
    '  The arc list and node colors of the graph:' )

  return
end
subroutine test14
!
!*******************************************************************************
!
!! TEST14 tests GRAPH_ARC_COLOR_POLY.
!
  implicit none
!
  integer, parameter :: nnode = 5
  integer, parameter :: nedge = 7
!
  integer cpoly1(nnode)
  integer cpoly2(nnode)
  integer cpoly3(nnode)
  integer, dimension ( nedge ) :: inode = &
    (/ 1, 1, 5, 1, 3, 1, 5 /)
  integer, dimension ( nedge ) :: jnode = &
    (/ 2, 3, 2, 4, 2, 5, 4 /)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST14'
  write ( *, '(a)') '  GRAPH_ARC_COLOR_POLY computes the chromatic polynomial.'

  call graph_arc_color_poly ( nnode, nedge, inode, jnode, cpoly1, cpoly2, &
    cpoly3 )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Computed values:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,5i4)' ) '    CPOLY1: ', cpoly1(1:nnode)
  write ( *, '(a,5i4)' ) '    CPOLY2: ', cpoly2(1:nnode)
  write ( *, '(a,5i4)' ) '    CPOLY3: ', cpoly3(1:nnode)

  cpoly1(1:nnode) = (/ 8, 20, 18, 7, 1 /)
  cpoly2(1:nnode) = (/ 0,  1,  3, 3, 1 /)
  cpoly3(1:nnode) = (/ 0,  0,  1, 3, 1 /)

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Correct values:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,5i4)' ) '    CPOLY1: ', cpoly1(1:nnode)
  write ( *, '(a,5i4)' ) '    CPOLY2: ', cpoly2(1:nnode)
  write ( *, '(a,5i4)' ) '    CPOLY3: ', cpoly3(1:nnode)

  return
end
subroutine test15
!
!*******************************************************************************
!
!! TEST15 tests GRAPH_ARC_CONECT.
!
  implicit none
!
  integer, parameter :: nedge = 17
  integer, parameter :: nnode = 14
!
  integer bridge(nedge)
  integer cutnod(nnode)
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 3, 4,5,13, 7,9,14,1,3,9, 7,9,5,9,1,6,4 /)
  integer iroot
  integer, dimension ( nedge ) :: jnode = &
    (/ 6,10,9,11,12,8,7,11,8,1,10,3,2,6,13,8,7 /)
  integer nbridg
  integer ncut
  integer next(nnode)
  integer numcmp
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST15'
  write ( *, '(a)' ) '  GRAPH_ARC_CONECT finds bridges, blocks, and cut nodes.'

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )

  next(1:nnode) = 0

  numcmp = 0

  do iroot = 1, nnode

    if ( next(iroot) == 0 ) then

      numcmp = numcmp + 1

      call graph_arc_conect ( nnode, nedge, inode, jnode, iroot, ncut, &
        nbridg, cutnod, bridge, next )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) '  Using component with root node:', iroot
      write ( *, '(a,i6)' ) '  The number of cut nodes is ', ncut
      write ( *, '(a,i6)' ) '  The number of bridges is ', nbridg

       if ( ncut > 0 ) then
         write ( *, '(a)' ) ' '
         write ( *, '(a)' ) '  The cut nodes are:'
         write ( *, '(a)' ) ' '
         write ( *, '(10i6)' ) cutnod(1:ncut)
       end if

       if ( nbridg > 0 ) then

         write ( *, '(a)' ) ' '
         write ( *, '(a)' ) '  The bridges are:'
         write ( *, '(a)' ) ' '

         do i = 1, nedge

           if ( bridge(i) > 0 ) then
             write ( *, '(4x,3i3)' ) i, inode(i), jnode(i)
           end if

         end do

       end if

     end if

  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The number of components is ', numcmp

  return
end
subroutine test16
!
!*******************************************************************************
!
!! TEST16 tests GRAPH_ARC_EDGE_CON.
!
  implicit none
!
  integer, parameter :: nedge = 17
  integer, parameter :: nnode = 9
!
  integer edge_con
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 6,2,3,6,7,1,4,7,3,4,9,6,5,4,2,9,4 /)
  integer, dimension ( nedge ) :: jnode = &
    (/ 8,5,1,3,2,8,3,5,8,1,2,1,9,8,6,7,2 /)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST16'
  write ( *, '(a)' ) '  GRAPH_ARC_EDGE_CON finds graph edge connectivity.'

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )

  call graph_arc_edge_con ( nnode, nedge, inode, jnode, edge_con )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The computed result:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The computed edge connectivity is ', edge_con

  edge_con = 2

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The correct result:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The computed edge connectivity is ', edge_con

  return
end
subroutine test17
!
!*******************************************************************************
!
!! TEST17 calls GRAPH_ARC_EULER.
!
  implicit none
!
  integer, parameter :: nedge = 7
  integer, parameter :: nnode = 5
!
  integer i
  integer in
  integer, dimension ( nedge ) :: inode = (/ 2, 1, 2, 1, 3, 5, 4 /)
  integer j
  integer, dimension ( nedge ) :: jnode = (/ 5, 4, 3, 2, 1, 1, 2 /)
  integer jp1
  logical success
  integer trail(nedge)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST17'
  write ( *, '(a)' ) '  GRAPH_ARC_EULER finds an Euler circuit of a graph.'

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )

  call graph_arc_euler ( nnode, nedge, inode, jnode, success, trail )

  if ( success ) then

    call ivec_print ( nedge, trail, '  The edge list of the Euler circuit:' )

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The node list of the Euler circuit:'
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '    I  Edge  Node'
    write ( *, '(a)' ) ' '

    do i = 1, nedge

      j = trail(i)

      if ( i == nedge ) then
        jp1 = trail(1)
      else
        jp1 = trail(i+1)
      end if

      if ( inode(j) == inode(jp1) .or. inode(j) == jnode(jp1) ) then
        in = inode(j)
      else if ( jnode(j) == inode(jp1) .or. jnode(j) == jnode(jp1) ) then
        in = jnode(j)
      else
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'The circuit has failed!'
        exit
      end if

      write ( *, '(3i6)' ) i, j, in

    end do

  else

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The graph is not eulerian.'
    write ( *, '(a)' ) ' '

  end if

  return
end
subroutine test18
!
!*******************************************************************************
!
!! TEST18 tests GRAPH_ARC_FCYCLE.
!
  implicit none
!
  integer, parameter :: nedge = 14
  integer, parameter :: nnode = 13
!
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 5, 4, 11, 6, 5,  7,  1, 8, 9, 10, 3,  1,  4, 6 /)
  integer, dimension ( nedge ) :: jnode = &
    (/ 9, 7, 13, 8, 2, 12, 11, 3, 1,  7, 9, 13, 10, 9 /)
  integer ncyc(nnode)
  integer numcmp
  integer numcyc
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST18:'
  write ( *, '(a)' ) '  GRAPH_ARC_FCYCLE finds fundamental cycles of a graph.'

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )

  call graph_arc_fcycle ( nnode, nedge, inode, jnode, numcyc, numcmp, ncyc )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Computed results:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  Number of cycles =     ', numcyc
  write ( *, '(a,i6)' ) '  Number of components = ', numcmp

  numcyc = 3
  numcmp = 2

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Correct results:'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  Number of cycles =     ', numcyc
  write ( *, '(a,i6)' ) '  Number of components = ', numcmp

  return
end
subroutine test19
!
!*******************************************************************************
!
!! TEST19 tests GRAPH_ARC_HAMCYC.
!
  implicit none
!
  integer, parameter :: nedge = 16
  integer, parameter :: nnode = 10
!
  integer hcycle(nnode)
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 2, 3,  8, 5, 4, 8, 10, 7, 5, 2, 1, 3, 9, 3, 6, 6 /)
  integer, dimension ( nedge ) :: jnode = &
    (/ 6, 5, 10, 2, 9, 1,  5, 4, 9, 4, 7, 8, 7, 7, 10, 1 /)
  logical success
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST19'
  write ( *, '(a)' ) '  GRAPH_ARC_HAMCYC finds a hamiltonian circuit.'

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )
 
  call graph_arc_hamcyc ( nnode, nedge, inode, jnode, success, hcycle )

  if ( success ) then

    call ivec_print ( nnode, hcycle, '  The Hamiltonian circuit:' )

  else

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'The graph is not hamiltonian.'

  end if

  return
end
subroutine test20
!
!*******************************************************************************
!
!! TEST20 tests GRAPH_ARC_MAKEG.
!
  implicit none
!
  integer, parameter :: edge_con = 5
  integer, parameter :: nnode = 8
  integer, parameter :: nedge = ( ( nnode * edge_con ) / 2 )
!
  integer edge_con2
  integer i
  integer inode(nedge)
  integer jnode(nedge)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST20:'
  write ( *, '(a)' ) '  GRAPH_ARC_MAKEG makes a graph of given connectivity.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Requested:'
  write ( *, '(a,i6)' ) '    Number of nodes =      ', nnode
  write ( *, '(a,i6)' ) '    Number of edges =      ', nedge
  write ( *, '(a,i6)' ) '    Edge connectivity =    ', edge_con

  call graph_arc_makeg ( nnode, edge_con, inode, jnode )
 
  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Call GRAPH_ARC_EDGE_CON to verify the connectivity.'

  call graph_arc_edge_con ( nnode, nedge, inode, jnode, edge_con2 )
 
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The computed edge connectivity is ', edge_con2

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The correct answer:'
  write ( *, '(a)' ) ' '

  inode = (/ 1, 2, 3, 4, 5, 6, 7, 8, 1, 1, 2, 2, 3, 4, 5, 6, 1, 2, 3, 4 /)
  jnode = (/ 2, 3, 4, 5, 6, 7, 8, 1, 3, 7, 4, 8, 5, 6, 7, 8, 5, 6, 7, 8 /)

  call graph_arc_print ( nedge, inode, jnode, '  The arc list of the graph:' )
 
  return
end
subroutine test21
!
!*******************************************************************************
!
!  TEST21 tests GRAPH_ARC_MATCH.
!
  implicit none
!
  integer, parameter :: nedge = 14
  integer, parameter :: nnode = 12
!
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 6, 9, 3,  4, 11, 6, 4, 5,  6, 10, 3, 4, 1, 3 /)
  integer, dimension ( nedge ) :: jnode = &
    (/ 2, 7, 7, 10,  5, 8, 6, 7, 12,  2, 1, 2, 5, 5 /)
  integer notmat
  integer pair(nnode)
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST21'
  write ( *, '(a)' ) '  GRAPH_ARC_MATCH finds a maximal matching in a graph.'

  call graph_arc_print ( nedge, inode, jnode, '  The edge list of the graph:' )

  call graph_arc_match ( nnode, nedge, inode, jnode, pair, notmat )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Node, matching node'
  write ( *, '(a)' ) ' '

  do i = 1, nnode
    write ( *, '(4x,2i6)' ) i, pair(i)
  end do 

  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The number of unmatched nodes is ', notmat

  return
end
subroutine test22
!
!*******************************************************************************
!
!! TEST22 tests GRAPH_ARC_MINTR2.
!
  implicit none
!
  integer, parameter :: nedge = 9
  integer, parameter :: nnode = 6
!
  real, dimension ( nedge ) :: arclen = &
    (/ 7.0, 3.0, 5.0, 1.0, 2.0, 2.0, 3.0, 4.0, 4.0 /)
  integer i
  integer, dimension ( nedge ) :: inode = &
    (/ 2, 4, 6, 2, 3, 4, 1, 2, 5 /)
  integer itree(nnode)
  integer j
  integer jtree(nnode)
  integer, dimension ( nedge ) :: jnode = &
    (/ 5, 1, 3, 4, 5, 6, 3, 6, 1 /)
  integer ntree
  real, dimension ( nnode-1 ) :: wtree
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST22'
  write ( *, '(a)' ) '  GRAPH_ARC_MINTR2 finds the minimum spanning tree:'

  call graph_arc_weight_print ( nedge, inode, jnode, arclen, &
    '  The weighted arc list of the graph:' )

  call graph_arc_mintr2 ( nnode, nedge, inode, jnode, arclen, ntree, &
    itree, jtree )

  do i = 1, ntree
    wtree(i) = 0.0
    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
        wtree(i) = arclen(j)
        exit
      end if
    end do
  end do

  call graph_arc_weight_print ( ntree, itree, jtree, wtree, &
    '  The weighted arc list of the tree:' )

  return
end
subroutine test23
!
!*******************************************************************************
!
!! TEST23 tests GRAPH_ARC_PLANAR.
!
  implicit none
!
  integer, parameter :: n = 10
  integer, parameter :: m = 22
!
  integer, dimension ( m ) :: inode = &
    (/ 9, 3, 10, 2, 6, 7,  7, 1, 8, 1, 10, 5, 1, 4, 1, 3, 9, 3, 2, 2, 5, 3 /)
  integer, dimension ( m ) :: jnode = &
    (/ 8, 2,  5, 4, 5, 9, 10, 3, 6, 2,  2, 8, 9, 7, 4, 5, 4, 6, 7, 5, 9, 8/)
  logical planar
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST23'
  write ( *, '(a)' ) '  GRAPH_ARC_PLANAR determines if a graph is planar.'

  call graph_arc_print ( m, inode, jnode, '  The edge list of the graph.' )

  call graph_arc_planar ( n, m, inode, jnode, planar )

  if ( planar ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The input graph is planar.'
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) '  The input graph is nonplanar.'
  end if

  return
end
subroutine test24
!
!*******************************************************************************
!
!! TEST24 tests GRAPH_DIST_MINTR1.
!
  implicit none
!
  integer, parameter :: nnode = 6
  integer, parameter :: lda = nnode
!
  real dist(lda,nnode)
  integer i
  integer itree(nnode-1)
  integer j
  integer jtree(nnode-1)
  real wtree(nnode-1)
!
  data dist / &
     0.0, 99.0,  3.0,  3.0,  4.0, 99.0, &
    99.0,  0.0, 99.0,  1.0,  7.0,  4.0, &
     3.0, 99.0,  0.0, 99.0,  2.0,  5.0, &
     3.0,  1.0, 99.0,  0.0, 99.0,  2.0, &
     4.0,  7.0,  2.0, 99.0,  0.0, 99.0, &
    99.0,  4.0,  5.0,  2.0, 99.0,  0.0 /

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST24'
  write ( *, '(a)' ) '  GRAPH_DIST_MINTR1 finds the minimum spanning tree:'

  call graph_dist_print ( dist, lda, nnode, '  The distance matrix:' )

  call graph_dist_mintr1 ( nnode, dist, lda, 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 weighted spanning tree:' )

  return
end