program main

c*********************************************************************72
c
cc components_test() tests components().
c
c  Licensing:
c
c    This code is distributed under the MIT license.
c
c  Modified:
c
c    17 July 2022
c
c  Author:
c
c    John Burkardt
c
      implicit none

      call timestamp ( )
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'components_test():'
      write ( *, '(a)' ) '  FORTRAN77 version'
      write ( *, '(a)' ) '  Test components().'

      call components_1d_test ( )
      call components_2d_test ( )
      call components_3d_test ( )
c
c  Terminate.
c
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'components_test():'
      write ( *, '(a)' ) '  Normal end of execution.'
      write ( *, '(a)' ) ' '
      call timestamp ( )

      stop
      end
      subroutine components_1d_test ( )

c*********************************************************************72
c
cc components_1d_test() tests components_1d().
c
c  Licensing:
c
c    This code is distributed under the MIT license.
c
c  Modified:
c
c    17 July 2022
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer, parameter :: n = 28

      integer a(n)
      integer c(n)
      integer component_num

      data a /
     &  0, 0, 1, 2, 4, 0, 0, 4, 0, 0, 
     &  0, 8, 9, 9, 1, 2, 3, 0, 0, 5, 
     &  0, 1, 6, 0, 0, 0, 4, 0 /

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'components_1d_test():'
      write ( *, '(a)' ) '  components_1d() finds and labels connected'
      write ( *, '(a)' ) '  components in a 1D integer vector.'

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  A:'
      write ( *, '(a)' ) ' '
      write ( *, '(4x,28i1)' ) a(1:n)

      call components_1d ( n, a, component_num, c )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i8)' ) '  Number of components = ', component_num
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  C:'
      write ( *, '(a)' ) ' '
      write ( *, '(4x,28i1)' ) c(1:n)

      return
      end
      subroutine components_2d_test ( )

c*********************************************************************72
c
cc components_2d_test() tests components_2d().
c
c  Licensing:
c
c    This code is distributed under the MIT license.
c
c  Modified:
c
c    17 July 2022
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer, parameter :: m = 9
      integer, parameter :: n = 17

      integer a(m,n)
      integer c(m,n)
      integer component_num
      integer i

      data a /
     &  0, 0, 0, 0, 0, 0, 0, 0, 0, 
     &  0, 0, 1, 0, 0, 1, 0, 0, 0, 
     &  0, 1, 1, 0, 1, 1, 1, 0, 0, 
     &  0, 1, 1, 1, 1, 1, 1, 0, 0, 
     &  0, 0, 1, 1, 1, 0, 0, 0, 0, 
     &  0, 0, 1, 1, 1, 0, 0, 0, 0, 
     &  0, 1, 1, 1, 0, 1, 0, 1, 0, 
     &  0, 1, 1, 0, 0, 1, 0, 1, 0, 
     &  0, 0, 1, 0, 0, 0, 0, 1, 0, 
     &  0, 0, 0, 0, 1, 0, 1, 1, 0, 
     &  0, 1, 0, 1, 1, 0, 1, 0, 0, 
     &  0, 1, 1, 1, 1, 1, 0, 0, 0, 
     &  0, 0, 1, 1, 0, 1, 0, 1, 0, 
     &  0, 0, 1, 1, 0, 1, 0, 1, 0, 
     &  0, 1, 1, 0, 1, 0, 1, 1, 0, 
     &  0, 1, 0, 0, 1, 0, 1, 1, 0, 
     &  0, 0, 0, 0, 0, 0, 0, 0, 0 /

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'components_2d_test():'
      write ( *, '(a)' ) '  components_2d() finds and labels connected'
      write ( *, '(a)' ) '  components in a 2D integer array.'

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  A:'
      write ( *, '(a)' ) ' '
      do i = 1, m
        write ( *, '(4x,17i1)' ) a(i,1:n)
      end do

      call components_2d ( m, n, a, component_num, c )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i8)' ) '  Number of components = ', component_num
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  C:'
      write ( *, '(a)' ) ' '
      do i = 1, m
        write ( *, '(4x,17i1)' ) c(i,1:n)
      end do

      return
      end
      subroutine components_3d_test ( )

c*********************************************************************72
c
cc components_3d_test() tests components_3d().
c
c  Discussion:
c
c    This calculation is also done by a program called REGION.
c    The two programs differ in the number of components discovered
c    because REGION uses the full 3x3 block of pixels, resulting
c    in 26 potential neighbors, whereas components_3d uses only
c    the north/south, east/west, up/down directions for 8 neighbors.
c
c  Licensing:
c
c    This code is distributed under the MIT license.
c
c  Modified:
c
c    17 July 2022
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer, parameter :: l = 64
      integer, parameter :: m = 64
      integer , parameter :: n = 26

      integer a(l,m,n)
      integer c(l,m,n)
      integer component_num
      character ( len = 80 ) filename
      integer i
      integer, allocatable :: indices(:,:)
      integer j
      integer j1
      integer k
      integer m1
      integer n1
      integer, allocatable :: s(:)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'components_3d_test():'
      write ( *, '(a)' ) '  components_3d() finds and labels connected'
      write ( *, '(a)' ) '  components in a 3D integer block.'

      write ( *, '(a)' ) ' '
      write ( *, '(a,i2,a,i2,a,i2)' ) 
     &  '  A is a 3D block of order ', l, ' * ',  m, ' * ', n

      a(1:l,1:m,1:n) = 0
c
c  Retrieve the indices of nonzero data in A by reading a file.
c
      filename = 'indices.txt'

      call i4mat_header_read ( filename, m1, n1 )

      allocate ( indices(m1,n1) )
      call i4mat_data_read ( filename, m1, n1, indices )

      do j1 = 1, n1
        i = indices(1,j1)
        j = indices(2,j1)
        k = indices(3,j1)
        a(i,j,k) = 1
      end do

      deallocate ( indices )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i8)' ) '  Number of nonzeros is ', sum ( a )
c
c  Determine the components.
c
      call components_3d ( l, m, n, a, component_num, c )

      allocate ( s(1:component_num) )

      s(1:component_num) = 0

      write ( *, '(a)' ) ' '
      write ( *, '(a,i8)' ) '  Number of components = ', component_num

      do i = 1, l
        do j = 1, m
          do k = 1, n
            if ( c(i,j,k) /= 0 ) then
              s(c(i,j,k)) = s(c(i,j,k)) + 1
            end if
          end do
        end do
      end do

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  Component  Size'
      write ( *, '(a)' ) ' '
      do i = 1, component_num
        write ( *, '(2x,i4,2x,i8)' ) i, s(i)
      end do
      write ( *, '(a)' ) '------  --------'
      write ( *, '(a6,2x,i8)' ) ' Total', sum ( s(1:component_num) )

      deallocate ( s )

      return
      end