program main !*****************************************************************************80 ! !! components_test() tests components(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 March 2025 ! ! Author: ! ! John Burkardt ! implicit none call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'components_test():' write ( *, '(a)' ) ' Fortran90 version' write ( *, '(a)' ) ' Test components().' call components_1d_test ( ) call components_2d_test ( ) call components_3d_test ( ) ! ! Terminate. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'components_test():' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) ' ' call timestamp ( ) stop 0 end subroutine components_1d_test ( ) !*****************************************************************************80 ! !! components_1d_test() tests components_1d(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 17 July 2022 ! ! Author: ! ! John Burkardt ! implicit none integer , parameter :: n = 28 integer :: a(n) = (/ & 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 /) integer c(n) integer component_num 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 ( ) !*****************************************************************************80 ! !! components_2d_test() tests components_2d(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 March 2025 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: m = 9 integer , parameter :: n = 17 integer :: a(m,n) = reshape ( (/ & 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 /), & (/ m, n /) ) integer c(m,n) integer component_num integer i 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 ( ) !*****************************************************************************80 ! !! components_3d_test() tests components_3d(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 March 2025 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: l = 64 integer, parameter :: m = 64 integer , parameter :: n = 26 integer, allocatable :: A(:,:,:) integer, allocatable :: C(:,:,:) integer component_num integer i integer j integer k integer, allocatable :: s(:) allocate ( A(1:l,1:m,1:n) ) allocate ( C(1:l,1:m,1:n) ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'components_3d_test():' write ( *, '(a)' ) ' components_3d() finds and labels connected' write ( *, '(a)' ) ' components in a 3D integer block.' ! ! Retrieve the indices of nonzero data in A by reading a file. ! write ( *, '(a)' ) ' ' write ( *, '(a,i2,a,i2,a,i2)' ) & ' A is a 3D block of order ', l, ' * ', m, ' * ', n call data_3d ( l, m, n, A ) write ( *, '(a)' ) ' ' write ( *, '(a,i8)' ) ' Number of nonzero A values is ', sum ( A ) ! ! Determine the components. ! 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 ( A ) deallocate ( C ) deallocate ( s ) return end subroutine data_3d ( l, m, n, A ) !*****************************************************************************80 ! !! data_3d() fills the array A with 3D 0/1 data. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 March 2025 ! ! Author: ! ! John Burkardt ! ! Input: ! ! integer l, m, n: the dimensions of A. ! ! Output: ! ! integer A(l,m,n): the data. ! implicit none integer l integer m integer n integer A(l,m,n) integer i integer, dimension ( 3, 1099 ) :: ijk = reshape ( (/ & 42, 43, 10, & 39, 46, 10, & 39, 46, 11, & 39, 47, 5, & 40, 45, 8, & 40, 46, 8, & 40, 46, 7, & 40, 47, 7, & 39, 47, 6, & 40, 48, 7, & 39, 49, 5, & 39, 48, 6, & 39, 48, 5, & 39, 49, 6, & 40, 50, 8, & 40, 50, 7, & 40, 49, 7, & 39, 49, 7, & 39, 50, 8, & 38, 50, 8, & 38, 50, 9, & 38, 50, 10, & 39, 50, 12, & 38, 50, 11, & 38, 49, 11, & 38, 48, 11, & 39, 49, 12, & 39, 48, 12, & 39, 47, 12, & 39, 47, 11, & 41, 48, 12, & 41, 47, 12, & 40, 48, 12, & 40, 47, 12, & 41, 47, 11, & 41, 47, 10, & 41, 47, 9, & 41, 46, 11, & 41, 45, 11, & 40, 47, 11, & 40, 46, 11, & 40, 46, 10, & 40, 46, 9, & 40, 45, 11, & 40, 45, 10, & 40, 45, 9, & 41, 46, 10, & 41, 46, 9, & 41, 46, 8, & 41, 45, 10, & 41, 44, 10, & 42, 45, 9, & 42, 45, 8, & 42, 44, 9, & 42, 43, 9, & 41, 45, 9, & 41, 45, 8, & 41, 44, 9, & 41, 44, 8, & 44, 43, 7, & 42, 44, 8, & 42, 43, 8, & 43, 43, 7, & 42, 44, 7, & 42, 43, 7, & 41, 44, 7, & 41, 44, 6, & 42, 44, 6, & 43, 45, 5, & 42, 45, 7, & 42, 45, 6, & 42, 45, 5, & 41, 46, 7, & 41, 45, 7, & 41, 45, 6, & 41, 45, 5, & 42, 46, 6, & 42, 46, 5, & 41, 46, 6, & 41, 46, 5, & 40, 46, 6, & 40, 46, 5, & 41, 47, 5, & 40, 47, 6, & 40, 47, 5, & 41, 48, 5, & 40, 50, 6, & 40, 49, 6, & 40, 49, 5, & 40, 48, 6, & 40, 48, 5, & 41, 49, 5, & 42, 50, 6, & 41, 50, 6, & 42, 50, 9, & 42, 50, 8, & 42, 50, 7, & 42, 49, 9, & 41, 50, 8, & 41, 50, 7, & 42, 49, 8, & 42, 49, 7, & 41, 49, 8, & 41, 49, 7, & 41, 49, 6, & 41, 48, 8, & 41, 48, 7, & 41, 48, 6, & 41, 47, 8, & 41, 47, 7, & 41, 47, 6, & 42, 48, 7, & 42, 47, 7, & 42, 46, 7, & 43, 47, 8, & 42, 48, 8, & 42, 47, 8, & 42, 46, 8, & 43, 47, 9, & 42, 48, 9, & 42, 47, 9, & 42, 46, 9, & 43, 47, 11, & 43, 47, 10, & 42, 47, 12, & 42, 47, 11, & 42, 47, 10, & 43, 46, 11, & 43, 46, 10, & 42, 46, 11, & 42, 46, 10, & 42, 45, 11, & 42, 45, 10, & 42, 44, 11, & 42, 44, 10, & 44, 44, 11, & 43, 45, 11, & 43, 44, 11, & 44, 44, 10, & 44, 43, 10, & 44, 43, 9, & 44, 43, 8, & 43, 45, 10, & 43, 44, 10, & 43, 43, 10, & 43, 43, 9, & 43, 43, 8, & 44, 44, 9, & 43, 46, 9, & 43, 45, 9, & 43, 44, 9, & 44, 45, 8, & 44, 44, 8, & 43, 46, 8, & 43, 45, 8, & 43, 45, 7, & 43, 45, 6, & 43, 44, 8, & 43, 44, 7, & 43, 44, 6, & 44, 45, 7, & 44, 45, 6, & 44, 44, 7, & 44, 44, 6, & 45, 45, 6, & 45, 44, 6, & 46, 45, 8, & 46, 45, 7, & 46, 44, 7, & 46, 43, 7, & 45, 45, 8, & 45, 45, 7, & 45, 44, 7, & 45, 43, 7, & 46, 44, 8, & 46, 43, 8, & 45, 44, 8, & 45, 43, 8, & 46, 43, 10, & 46, 43, 9, & 45, 43, 10, & 45, 43, 9, & 46, 44, 10, & 46, 44, 9, & 45, 44, 10, & 45, 44, 9, & 46, 45, 10, & 46, 45, 9, & 45, 45, 10, & 45, 45, 9, & 44, 46, 11, & 44, 45, 11, & 44, 45, 10, & 44, 45, 9, & 45, 46, 10, & 44, 47, 10, & 44, 46, 10, & 45, 47, 9, & 45, 46, 9, & 44, 47, 9, & 44, 46, 9, & 45, 47, 8, & 45, 46, 8, & 44, 47, 8, & 44, 46, 8, & 45, 47, 7, & 45, 46, 7, & 45, 46, 6, & 44, 47, 7, & 44, 46, 7, & 44, 46, 6, & 43, 47, 7, & 43, 46, 7, & 43, 46, 6, & 43, 46, 5, & 44, 47, 6, & 43, 47, 6, & 43, 47, 5, & 42, 49, 6, & 42, 49, 5, & 42, 48, 6, & 42, 48, 5, & 42, 47, 6, & 42, 47, 5, & 43, 48, 5, & 44, 49, 6, & 44, 48, 6, & 43, 50, 6, & 43, 49, 6, & 43, 48, 6, & 44, 49, 7, & 44, 48, 7, & 43, 50, 7, & 43, 49, 7, & 43, 48, 7, & 44, 49, 8, & 44, 48, 8, & 43, 50, 8, & 43, 49, 8, & 43, 48, 8, & 44, 49, 9, & 44, 48, 9, & 43, 49, 9, & 43, 48, 9, & 44, 49, 10, & 44, 48, 10, & 43, 48, 11, & 43, 48, 10, & 42, 48, 12, & 42, 48, 11, & 42, 48, 10, & 43, 49, 11, & 43, 49, 10, & 42, 50, 11, & 42, 50, 10, & 42, 49, 12, & 42, 49, 11, & 42, 49, 10, & 41, 50, 12, & 41, 49, 12, & 40, 50, 12, & 40, 49, 12, & 41, 50, 11, & 41, 50, 10, & 41, 50, 9, & 41, 49, 11, & 41, 49, 10, & 41, 49, 9, & 41, 48, 11, & 41, 48, 10, & 41, 48, 9, & 40, 50, 11, & 40, 50, 10, & 40, 50, 9, & 40, 49, 11, & 40, 48, 11, & 39, 50, 11, & 39, 50, 10, & 39, 50, 9, & 39, 49, 11, & 39, 48, 11, & 40, 49, 10, & 40, 49, 9, & 40, 49, 8, & 40, 48, 10, & 40, 48, 9, & 40, 48, 8, & 40, 47, 10, & 40, 47, 9, & 40, 47, 8, & 39, 49, 10, & 39, 49, 9, & 39, 49, 8, & 39, 48, 10, & 39, 47, 10, & 38, 49, 10, & 38, 49, 9, & 38, 49, 8, & 38, 48, 10, & 38, 47, 10, & 39, 48, 9, & 39, 48, 8, & 39, 48, 7, & 39, 47, 9, & 39, 47, 8, & 39, 47, 7, & 39, 46, 9, & 39, 46, 8, & 38, 48, 9, & 38, 48, 8, & 38, 47, 9, & 38, 47, 8, & 39, 27, 17, & 38, 27, 17, & 39, 29, 17, & 39, 28, 17, & 38, 29, 17, & 38, 28, 17, & 38, 29, 18, & 38, 28, 18, & 39, 29, 21, & 38, 29, 20, & 38, 29, 19, & 38, 28, 20, & 38, 28, 19, & 39, 29, 20, & 39, 29, 19, & 39, 29, 18, & 39, 28, 18, & 41, 30, 19, & 41, 30, 18, & 41, 29, 19, & 41, 29, 18, & 41, 29, 17, & 40, 29, 19, & 40, 29, 18, & 40, 29, 17, & 41, 28, 18, & 41, 28, 17, & 40, 28, 18, & 40, 28, 17, & 40, 27, 17, & 40, 26, 17, & 41, 22, 14, & 41, 22, 16, & 41, 22, 15, & 41, 23, 16, & 41, 24, 16, & 42, 24, 12, & 42, 24, 11, & 41, 24, 12, & 41, 24, 11, & 42, 25, 12, & 42, 25, 11, & 41, 25, 12, & 41, 25, 11, & 42, 27, 11, & 42, 26, 11, & 41, 26, 11, & 42, 27, 12, & 42, 26, 12, & 41, 27, 12, & 41, 26, 12, & 42, 27, 15, & 42, 27, 14, & 42, 27, 13, & 41, 27, 15, & 41, 27, 14, & 41, 27, 13, & 42, 26, 14, & 42, 26, 13, & 41, 26, 15, & 41, 26, 14, & 41, 26, 13, & 42, 25, 14, & 42, 25, 13, & 42, 24, 13, & 41, 25, 15, & 41, 25, 14, & 41, 25, 13, & 41, 24, 15, & 41, 24, 14, & 41, 24, 13, & 41, 23, 15, & 41, 23, 14, & 43, 23, 16, & 43, 22, 16, & 43, 22, 15, & 43, 22, 14, & 42, 24, 14, & 42, 23, 16, & 42, 23, 15, & 42, 23, 14, & 42, 22, 16, & 42, 22, 15, & 42, 22, 14, & 43, 23, 15, & 43, 23, 14, & 44, 24, 14, & 43, 24, 14, & 44, 25, 13, & 44, 24, 13, & 44, 24, 12, & 43, 25, 13, & 43, 24, 13, & 43, 24, 12, & 43, 24, 11, & 44, 25, 12, & 44, 25, 11, & 43, 25, 12, & 43, 25, 11, & 44, 27, 11, & 44, 26, 11, & 43, 27, 11, & 43, 26, 11, & 44, 27, 12, & 44, 26, 12, & 43, 27, 12, & 43, 26, 12, & 44, 27, 13, & 44, 26, 13, & 43, 27, 13, & 43, 26, 13, & 44, 27, 15, & 44, 27, 14, & 44, 26, 14, & 44, 25, 14, & 43, 27, 15, & 43, 27, 14, & 43, 26, 14, & 43, 25, 14, & 44, 26, 15, & 44, 25, 15, & 44, 24, 15, & 43, 26, 15, & 43, 25, 15, & 43, 24, 16, & 43, 24, 15, & 42, 26, 15, & 42, 25, 15, & 42, 24, 16, & 42, 24, 15, & 43, 25, 16, & 42, 25, 16, & 41, 27, 18, & 41, 27, 17, & 41, 26, 18, & 41, 26, 17, & 41, 25, 18, & 41, 25, 16, & 42, 26, 17, & 43, 27, 17, & 42, 27, 17, & 43, 28, 17, & 42, 29, 17, & 42, 28, 17, & 45, 31, 17, & 45, 30, 17, & 45, 29, 17, & 44, 31, 18, & 43, 31, 18, & 43, 29, 17, & 44, 30, 18, & 43, 30, 18, & 42, 30, 19, & 42, 30, 18, & 43, 29, 19, & 43, 29, 18, & 42, 29, 19, & 42, 29, 18, & 43, 28, 19, & 43, 28, 18, & 43, 27, 18, & 42, 28, 19, & 42, 28, 18, & 42, 27, 18, & 42, 26, 18, & 43, 27, 19, & 42, 27, 19, & 42, 26, 19, & 41, 25, 20, & 41, 25, 19, & 42, 26, 20, & 43, 27, 21, & 43, 27, 20, & 45, 27, 21, & 44, 27, 21, & 45, 29, 21, & 45, 28, 21, & 44, 28, 21, & 45, 29, 20, & 45, 29, 19, & 45, 29, 18, & 45, 28, 20, & 45, 27, 20, & 44, 29, 19, & 44, 29, 18, & 44, 28, 20, & 44, 28, 19, & 44, 28, 18, & 44, 27, 20, & 44, 27, 19, & 44, 27, 18, & 45, 28, 19, & 45, 28, 18, & 45, 28, 17, & 45, 27, 19, & 45, 27, 18, & 47, 27, 18, & 46, 27, 18, & 47, 27, 19, & 46, 27, 19, & 47, 27, 21, & 47, 27, 20, & 46, 27, 21, & 46, 27, 20, & 47, 30, 21, & 47, 29, 21, & 47, 28, 21, & 46, 29, 21, & 46, 28, 21, & 47, 29, 20, & 47, 28, 20, & 46, 29, 20, & 46, 28, 20, & 47, 29, 19, & 47, 28, 19, & 47, 28, 18, & 47, 28, 17, & 46, 29, 19, & 46, 28, 19, & 46, 28, 18, & 46, 28, 17, & 47, 29, 18, & 47, 29, 17, & 46, 29, 18, & 46, 29, 17, & 47, 31, 17, & 47, 30, 17, & 46, 31, 17, & 46, 30, 17, & 47, 31, 19, & 47, 31, 18, & 47, 30, 20, & 47, 30, 19, & 47, 30, 18, & 46, 31, 18, & 46, 30, 18, & 45, 31, 18, & 45, 30, 18, & 46, 31, 19, & 46, 30, 21, & 46, 30, 20, & 46, 30, 19, & 45, 31, 20, & 45, 31, 19, & 45, 30, 21, & 45, 30, 20, & 45, 30, 19, & 44, 31, 19, & 44, 30, 19, & 43, 31, 19, & 43, 30, 19, & 44, 31, 20, & 44, 30, 21, & 44, 30, 20, & 44, 29, 21, & 44, 29, 20, & 43, 31, 20, & 43, 30, 21, & 43, 30, 20, & 43, 29, 21, & 43, 29, 20, & 43, 28, 21, & 43, 28, 20, & 42, 30, 21, & 42, 30, 20, & 41, 30, 20, & 42, 29, 21, & 42, 29, 20, & 42, 28, 21, & 42, 28, 20, & 42, 27, 21, & 42, 27, 20, & 41, 29, 21, & 41, 29, 20, & 40, 29, 21, & 40, 29, 20, & 41, 28, 21, & 41, 28, 20, & 41, 28, 19, & 41, 27, 21, & 41, 27, 20, & 41, 27, 19, & 41, 26, 21, & 41, 26, 20, & 41, 26, 19, & 40, 28, 21, & 40, 28, 20, & 40, 28, 19, & 40, 27, 21, & 40, 26, 21, & 39, 28, 21, & 39, 28, 20, & 39, 28, 19, & 39, 27, 21, & 39, 26, 21, & 40, 27, 20, & 40, 27, 19, & 40, 27, 18, & 40, 26, 20, & 40, 26, 19, & 40, 26, 18, & 40, 25, 20, & 40, 25, 19, & 40, 25, 18, & 39, 27, 20, & 39, 27, 19, & 39, 27, 18, & 39, 26, 20, & 39, 25, 20, & 38, 27, 20, & 38, 27, 19, & 38, 27, 18, & 38, 26, 20, & 38, 25, 20, & 39, 26, 19, & 39, 26, 18, & 39, 26, 17, & 39, 25, 19, & 39, 25, 18, & 38, 26, 19, & 38, 26, 18, & 38, 26, 17, & 38, 25, 19, & 38, 25, 18, & 31, 26, 9, & 31, 25, 8, & 31, 25, 7, & 33, 23, 7, & 32, 23, 7, & 31, 24, 7, & 31, 23, 7, & 32, 23, 8, & 31, 24, 8, & 31, 23, 8, & 32, 23, 9, & 32, 23, 10, & 31, 23, 12, & 32, 23, 12, & 32, 23, 11, & 34, 24, 12, & 34, 23, 12, & 33, 24, 12, & 33, 23, 12, & 34, 24, 11, & 34, 23, 11, & 33, 24, 11, & 33, 23, 11, & 34, 24, 10, & 34, 23, 10, & 33, 24, 10, & 33, 23, 10, & 33, 23, 9, & 33, 23, 8, & 34, 24, 9, & 33, 25, 7, & 33, 24, 9, & 33, 24, 8, & 33, 24, 7, & 32, 26, 9, & 32, 25, 9, & 32, 25, 8, & 32, 25, 7, & 32, 24, 9, & 32, 24, 8, & 32, 24, 7, & 33, 25, 8, & 34, 26, 9, & 34, 25, 9, & 33, 26, 9, & 33, 25, 9, & 34, 26, 10, & 34, 25, 10, & 33, 26, 10, & 33, 25, 10, & 34, 26, 12, & 34, 26, 11, & 34, 25, 12, & 34, 25, 11, & 33, 26, 12, & 33, 26, 11, & 33, 25, 12, & 33, 25, 11, & 32, 26, 12, & 32, 26, 11, & 32, 26, 10, & 32, 25, 12, & 32, 25, 11, & 32, 25, 10, & 32, 24, 12, & 32, 24, 11, & 32, 24, 10, & 31, 26, 12, & 31, 26, 11, & 31, 26, 10, & 31, 25, 12, & 31, 24, 12, & 30, 26, 12, & 30, 26, 11, & 30, 26, 10, & 30, 25, 12, & 30, 24, 12, & 31, 25, 11, & 31, 25, 10, & 31, 25, 9, & 31, 24, 11, & 31, 24, 10, & 31, 24, 9, & 31, 23, 11, & 31, 23, 10, & 31, 23, 9, & 30, 25, 11, & 30, 25, 10, & 30, 24, 11, & 30, 24, 10, & 26, 52, 10, & 25, 52, 9, & 25, 51, 9, & 24, 51, 9, & 24, 51, 8, & 24, 50, 9, & 24, 50, 8, & 24, 49, 9, & 24, 49, 8, & 25, 50, 9, & 25, 49, 9, & 25, 49, 8, & 25, 52, 5, & 26, 52, 5, & 28, 48, 5, & 28, 48, 4, & 28, 49, 4, & 27, 49, 4, & 28, 50, 4, & 27, 50, 4, & 28, 52, 4, & 28, 51, 4, & 27, 52, 4, & 27, 51, 4, & 28, 52, 6, & 28, 52, 5, & 27, 52, 5, & 28, 51, 6, & 28, 51, 5, & 28, 50, 5, & 28, 49, 5, & 27, 51, 5, & 27, 50, 5, & 27, 49, 5, & 28, 50, 6, & 28, 49, 6, & 28, 48, 6, & 27, 49, 6, & 28, 48, 10, & 28, 48, 9, & 28, 48, 8, & 27, 49, 7, & 27, 49, 8, & 26, 49, 8, & 27, 50, 9, & 27, 49, 9, & 26, 51, 10, & 26, 50, 10, & 26, 50, 9, & 26, 49, 10, & 26, 49, 9, & 27, 50, 10, & 27, 49, 10, & 29, 50, 11, & 28, 50, 11, & 28, 49, 11, & 29, 50, 10, & 28, 50, 10, & 28, 49, 10, & 29, 50, 9, & 28, 50, 9, & 28, 50, 8, & 28, 50, 7, & 28, 49, 9, & 28, 49, 8, & 28, 49, 7, & 29, 50, 8, & 29, 49, 8, & 29, 48, 8, & 30, 49, 7, & 29, 49, 7, & 30, 49, 6, & 30, 48, 6, & 30, 48, 5, & 30, 48, 4, & 29, 49, 6, & 29, 48, 6, & 29, 48, 5, & 29, 48, 4, & 30, 49, 5, & 30, 49, 4, & 29, 49, 5, & 29, 49, 4, & 30, 51, 4, & 30, 50, 4, & 29, 52, 4, & 29, 51, 4, & 29, 50, 4, & 30, 51, 5, & 30, 50, 7, & 30, 50, 6, & 30, 50, 5, & 29, 52, 5, & 29, 51, 5, & 29, 50, 7, & 29, 50, 6, & 29, 50, 5, & 30, 51, 6, & 29, 52, 6, & 29, 51, 6, & 30, 52, 7, & 30, 51, 7, & 29, 52, 7, & 29, 51, 7, & 30, 52, 8, & 31, 51, 9, & 31, 51, 8, & 30, 51, 8, & 31, 50, 9, & 31, 50, 8, & 31, 49, 8, & 30, 50, 9, & 30, 50, 8, & 30, 49, 8, & 30, 48, 8, & 31, 49, 9, & 30, 49, 9, & 30, 48, 9, & 29, 49, 11, & 29, 49, 10, & 29, 49, 9, & 29, 48, 10, & 29, 48, 9, & 30, 48, 10, & 31, 49, 11, & 31, 49, 10, & 30, 49, 11, & 30, 49, 10, & 31, 50, 11, & 31, 50, 10, & 30, 50, 11, & 30, 50, 10, & 31, 51, 11, & 31, 51, 10, & 30, 52, 11, & 30, 52, 10, & 30, 52, 9, & 30, 51, 11, & 30, 51, 10, & 30, 51, 9, & 29, 52, 11, & 29, 51, 11, & 28, 52, 11, & 28, 51, 11, & 29, 52, 10, & 29, 52, 9, & 29, 52, 8, & 29, 51, 10, & 29, 51, 9, & 29, 51, 8, & 28, 52, 10, & 28, 51, 10, & 27, 52, 10, & 27, 51, 10, & 28, 52, 9, & 28, 52, 8, & 28, 52, 7, & 28, 51, 9, & 28, 51, 8, & 28, 51, 7, & 27, 52, 9, & 27, 51, 9, & 26, 52, 9, & 26, 51, 9, & 27, 52, 8, & 27, 52, 7, & 27, 52, 6, & 27, 51, 8, & 27, 51, 7, & 27, 51, 6, & 27, 50, 8, & 27, 50, 7, & 27, 50, 6, & 26, 52, 8, & 26, 52, 7, & 26, 52, 6, & 26, 51, 8, & 26, 50, 8, & 25, 52, 8, & 25, 52, 7, & 25, 52, 6, & 25, 51, 8, & 25, 50, 8, & 26, 51, 7, & 26, 51, 6, & 26, 51, 5, & 26, 50, 7, & 26, 50, 6, & 26, 50, 5, & 26, 49, 7, & 26, 49, 6, & 26, 49, 5, & 25, 51, 7, & 25, 51, 6, & 25, 51, 5, & 25, 50, 7, & 25, 49, 7, & 24, 51, 7, & 24, 51, 6, & 24, 51, 5, & 24, 50, 7, & 24, 49, 7, & 25, 50, 6, & 25, 50, 5, & 25, 49, 6, & 25, 49, 5, & 24, 50, 6, & 24, 50, 5, & 24, 49, 6, & 24, 49, 5, & 25, 27, 8, & 24, 30, 3, & 24, 32, 3, & 24, 31, 3, & 25, 29, 9, & 24, 29, 9, & 23, 29, 9, & 22, 29, 9, & 22, 30, 9, & 22, 31, 9, & 22, 31, 5, & 22, 33, 5, & 22, 32, 5, & 22, 33, 6, & 22, 32, 6, & 22, 33, 8, & 22, 33, 7, & 22, 32, 9, & 22, 32, 8, & 22, 32, 7, & 23, 33, 8, & 24, 33, 7, & 24, 33, 6, & 24, 33, 5, & 23, 33, 7, & 23, 33, 6, & 23, 33, 5, & 24, 32, 6, & 24, 32, 5, & 24, 32, 4, & 24, 31, 4, & 24, 30, 4, & 23, 32, 6, & 23, 32, 5, & 23, 32, 4, & 23, 31, 5, & 23, 31, 4, & 23, 30, 4, & 24, 31, 5, & 24, 30, 5, & 25, 30, 6, & 25, 29, 8, & 25, 28, 8, & 24, 28, 8, & 25, 29, 7, & 25, 29, 6, & 25, 28, 7, & 25, 27, 7, & 24, 29, 5, & 24, 28, 7, & 24, 28, 6, & 25, 28, 6, & 25, 28, 5, & 25, 27, 6, & 25, 27, 5, & 27, 27, 5, & 26, 27, 5, & 27, 27, 6, & 26, 27, 6, & 27, 27, 8, & 27, 27, 7, & 26, 27, 8, & 26, 27, 7, & 27, 29, 8, & 27, 28, 8, & 26, 30, 8, & 26, 29, 8, & 26, 28, 8, & 27, 29, 7, & 27, 28, 7, & 26, 30, 7, & 26, 29, 7, & 26, 28, 7, & 27, 29, 6, & 27, 28, 6, & 27, 28, 5, & 26, 30, 6, & 26, 29, 6, & 26, 28, 6, & 26, 28, 5, & 27, 29, 5, & 26, 30, 5, & 26, 29, 5, & 25, 30, 5, & 25, 29, 5, & 26, 30, 4, & 26, 30, 3, & 25, 30, 4, & 25, 30, 3, & 26, 32, 3, & 26, 31, 3, & 25, 32, 3, & 25, 31, 3, & 26, 32, 4, & 26, 31, 4, & 25, 32, 4, & 25, 31, 4, & 26, 32, 5, & 26, 31, 5, & 25, 33, 5, & 25, 32, 5, & 25, 31, 5, & 26, 32, 6, & 26, 31, 6, & 25, 33, 6, & 25, 32, 6, & 25, 31, 6, & 26, 32, 7, & 26, 31, 7, & 25, 33, 7, & 26, 32, 8, & 26, 31, 8, & 25, 33, 8, & 24, 33, 8, & 25, 32, 9, & 25, 32, 8, & 25, 32, 7, & 25, 31, 9, & 25, 31, 8, & 25, 31, 7, & 25, 30, 9, & 25, 30, 8, & 25, 30, 7, & 24, 32, 9, & 24, 32, 8, & 24, 32, 7, & 24, 31, 9, & 24, 30, 9, & 23, 32, 9, & 23, 32, 8, & 23, 32, 7, & 23, 31, 9, & 23, 30, 9, & 24, 31, 8, & 24, 31, 7, & 24, 31, 6, & 24, 30, 8, & 24, 30, 7, & 24, 30, 6, & 24, 29, 8, & 24, 29, 7, & 24, 29, 6, & 23, 31, 8, & 23, 31, 7, & 23, 31, 6, & 23, 30, 8, & 23, 29, 8, & 22, 31, 8, & 22, 31, 7, & 22, 31, 6, & 22, 30, 8, & 22, 29, 8, & 23, 30, 7, & 23, 30, 6, & 23, 30, 5, & 23, 29, 7, & 23, 29, 6, & 23, 29, 5, & 22, 30, 7, & 22, 30, 6, & 22, 30, 5, & 22, 29, 7, & 22, 29, 6 /), (/ 3, 1099 /) ) do i = 1, 1099 A(ijk(1,i),ijk(2,i),ijk(3,i)) = 1 end do return end subroutine timestamp ( ) !*****************************************************************************80 ! !! timestamp() prints the current YMDHMS date as a time stamp. ! ! Example: ! ! 31 May 2001 9:45:54.872 AM ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 18 May 2013 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none character ( len = 8 ) ampm integer d 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 integer values(8) integer y call date_and_time ( values = 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 ( *, '(i2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end