program main

c*********************************************************************72
c
cc tetrahedron_test() tests tetrahedron().
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    04 May 2022
c
c  Author:
c
c    John Burkardt
c
      implicit none

      call timestamp ( )
      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_test():'
      write ( *, '(a)' ) '  FORTRAN77 version'
      write ( *, '(a)' ) '  Test tetrahedron().'

      call tetrahedron_centroid_test ( )
      call tetrahedron_circumsphere_test ( )
      call tetrahedron_edge_length_test ( )
      call tetrahedron_insphere_test ( )
      call tetrahedron_quality1_test ( )
      call tetrahedron_quality2_test ( )
      call tetrahedron_quality3_test ( )
      call tetrahedron_quality4_test ( )
      call tetrahedron_solid_angles_test ( )
      call tetrahedron_volume_test ( )
c
c  Terminate.
c
      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_test():'
      write ( *, '(a)' ) '  Normal end of execution.'
      write ( *, '(a)' ) ''
      call timestamp ( )

      stop 0
      end
      subroutine tetrahedron_centroid_test ( )

c*********************************************************************72
c
cc tetrahedron_centroid_test() tests tetrahedron_centroid();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    14 October 2006
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )

      double precision centroid(dim_num)
      double precision tetra(dim_num,4)
      save tetra
      data tetra /
     &   0.000000D+00,  0.942809D+00, -0.333333D+00,
     &  -0.816496D+00, -0.816496D+00, -0.333333D+00,
     &   0.816496D+00, -0.816496D+00, -0.333333D+00,
     &   0.000000D+00,  0.000000D+00,  1.000000D+00 /

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_centroid_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_centroid() computes the centroid'
      write ( *, '(a)' ) '  of a tetrahedron.'

      call r8mat_transpose_print ( dim_num, 4, tetra, 
     & '  Tetrahedron vertices:' )

      call tetrahedron_centroid ( tetra, centroid )

      call r8vec_print ( dim_num, centroid, '  Centroid:' )

      return
      end
      subroutine tetrahedron_circumsphere_test ( )

c*********************************************************************72
c
cc tetrahedron_circumsphere_test() tests tetrahedron_circumsphere();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    09 August 2005
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )

      double precision pc(dim_num)
      double precision r
      double precision tetra(dim_num,4)
      save tetra
      data tetra /
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.816496580927726D+00 /

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_circumsphere_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_circumsphere() computes the circumsphere'
      write ( *, '(a)' ) '  of a tetrahedron.'

      call r8mat_transpose_print ( dim_num, 4, tetra, 
     &  '  Tetrahedron vertices:' )

      call tetrahedron_circumsphere ( tetra, r, pc )

      call r8vec_print ( dim_num, pc, '  Circumsphere center:' )

      write ( *, '(a)' ) ''
      write ( *, '(a,g14.6)' ) '  Circumsphere radius is ', r
 
      return
      end
      subroutine tetrahedron_edge_length_test ( )

c*********************************************************************72
c
cc tetrahedron_edge_length_test() tests tetrahedron_edge_length();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    09 August 2005
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )

      double precision edge_length(6)
      double precision tetra(dim_num,4)
      save tetra
      data tetra /
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.816496580927726D+00 /

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_edge_length_test():'
      write ( *, '(a)' ) 
     &'  tetrahedron_edge_length() computes the edge lengths'
      write ( *, '(a)' ) '  of a tetrahedron.'

      call r8mat_transpose_print ( dim_num, 4, tetra, 
     &  '  Tetrahedron vertices:' )

      call tetrahedron_edge_length ( tetra, edge_length )

      call r8vec_print ( 6, edge_length, '  Edge lengths:' )
 
      return
      end
      subroutine tetrahedron_insphere_test ( )

c*********************************************************************72
c
cc tetrahedron_insphere_test() tests tetrahedron_insphere();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    08 August 2005
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )

      double precision pc(dim_num)
      double precision r
      double precision tetra(dim_num,4)
      save tetra
      data tetra /
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.816496580927726D+00 /

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_insphere_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_insphere() computes the insphere'
      write ( *, '(a)' ) '  of a tetrahedron.'

      call r8mat_transpose_print ( dim_num, 4, tetra, 
     &  '  Tetrahedron vertices:' )

      call tetrahedron_insphere ( tetra, r, pc )

      call r8vec_print ( dim_num, pc, '  Insphere center:' )

      write ( *, '(a)' ) ''
      write ( *, '(a,g14.6)' ) '  Insphere radius is ', r
 
      return
      end
      subroutine tetrahedron_quality1_test ( )

c*********************************************************************72
c
cc tetrahedron_quality1_test tests tetrahedron_quality1();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    17 August 2005
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )
      integer test_num
      parameter ( test_num = 2 )

      double precision quality
      double precision, dimension(dim_num,4) :: tetra
      double precision tetra_test(dim_num,4,test_num)
      save tetra_test
      data tetra_test /
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.816496580927726D+00,
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.408248290463863D+00 /
      integer test

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_quality1_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_quality1() computes quality measure #1'
      write ( *, '(a)' ) '  of a tetrahedron.'

      do test = 1, test_num

        tetra(1:dim_num,1:4) = tetra_test(1:dim_num,1:4,test)

        call r8mat_transpose_print ( dim_num, 4, tetra, 
     &    '  Tetrahedron vertices:' )

        call tetrahedron_quality1 ( tetra, quality )

        write ( *, '(a,g14.6)' ) '  Tetrahedron quality is ', quality

      end do
 
      return
      end
      subroutine tetrahedron_quality2_test ( )

c*********************************************************************72
c
cc tetrahedron_quality2_test() tests tetrahedron_quality2();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    17 August 2005
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )
      integer test_num
      parameter ( test_num = 2 )

      double precision quality2
      double precision, dimension(dim_num,4) :: tetra
      double precision tetra_test(dim_num,4,test_num)
      save tetra_test
      data tetra_test /
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.816496580927726D+00,
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.408248290463863D+00 /
      integer test

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_quality2_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_quality2() computes quality measure #2'
      write ( *, '(a)' ) '  of a tetrahedron.'

      do test = 1, test_num

        tetra(1:dim_num,1:4) = tetra_test(1:dim_num,1:4,test)

        call r8mat_transpose_print ( dim_num, 4, tetra, 
     &    '  Tetrahedron vertices:' )

        call tetrahedron_quality2 ( tetra, quality2 )

        write ( *, '(a,g14.6)' ) '  Tetrahedron quality is ', quality2

      end do

      return
      end
      subroutine tetrahedron_quality3_test ( )

c*********************************************************************72
c
cc tetrahedron_quality3_test tests tetrahedron_quality3();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    17 August 2005
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )
      integer test_num
      parameter ( test_num = 2 )

      double precision quality3
      double precision, dimension(dim_num,4) :: tetra
      double precision tetra_test(dim_num,4,test_num)
      save tetra_test
      data tetra_test /
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.816496580927726D+00,
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.408248290463863D+00 /
      integer test

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_quality3_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_quality3() computes quality measure #3'
      write ( *, '(a)' ) '  of a tetrahedron.'

      do test = 1, test_num

        tetra(1:dim_num,1:4) = tetra_test(1:dim_num,1:4,test)

        call r8mat_transpose_print ( dim_num, 4, tetra, 
     &    '  Tetrahedron vertices:' )

        call tetrahedron_quality3 ( tetra, quality3 )

        write ( *, '(a,g14.6)' ) '  Tetrahedron quality is ', quality3

      end do

      return
      end
      subroutine tetrahedron_quality4_test ( )

c*********************************************************************72
c
cc tetrahedron_quality4_test() tests tetrahedron_quality4();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    17 August 2005
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )
      integer test_num
      parameter ( test_num = 2 )

      double precision quality4
      double precision, dimension(dim_num,4) :: tetra
      double precision tetra_test(dim_num,4,test_num)
      save tetra_test
      data tetra_test /
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.816496580927726D+00,
     &   0.577350269189626D+00,  0.0D+00, 0.0D+00,
     &  -0.288675134594813D+00,  0.5D+00, 0.0D+00,
     &  -0.288675134594813D+00, -0.5D+00, 0.0D+00,
     &   0.0D+00,                0.0D+00, 0.408248290463863D+00 /
      integer test

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_quality4_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_quality4() computes quality measure #4'
      write ( *, '(a)' ) '  of a tetrahedron.'

      do test = 1, test_num

        tetra(1:dim_num,1:4) = tetra_test(1:dim_num,1:4,test)

        call r8mat_transpose_print ( dim_num, 4, tetra, 
     &    '  Tetrahedron vertices:' )

        call tetrahedron_quality4 ( tetra, quality4 )

        write ( *, '(a,g14.6)' ) '  Tetrahedron quality is ', quality4

      end do

      return
      end
      subroutine tetrahedron_solid_angles_test ( )

c*********************************************************************72
c
cc tetrahedron_solid_angles_test() tests tetrahedron_solid_angles();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    28 May 2015
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )

      double precision angle(4)
      double precision t1(3,4)
      save t1
      data t1 /
     &   0.000000D+00,  0.942809D+00, -0.333333D+00,
     &  -0.816496D+00, -0.816496D+00, -0.333333D+00,
     &   0.816496D+00, -0.816496D+00, -0.333333D+00,
     &   0.000000D+00,  0.000000D+00,  1.000000D+00 /
      double precision t2(3,4)
      save t2
      data t2 /
     &   0.000000D+00,  0.000000D+00,  0.000000D+00,
     &   1.000000D+00,  0.000000D+00,  0.000000D+00,
     &   0.000000D+00,  1.000000D+00,  0.000000D+00,
     &   0.000000D+00,  0.000000D+00,  1.000000D+00 /
      double precision t3(3,4)
      save t3
      data t3 /
     &   0.000000D+00,  0.000000D+00,  0.000000D+00,
     &   1.000000D+00,  0.000000D+00,  0.000000D+00,
     &   0.000000D+00,  2.000000D+00,  0.000000D+00,
     &   0.000000D+00,  0.000000D+00,  4.000000D+00 /
      double precision t4(3,4)
      save t4
      data t4 /
     &   0.000000D+00,  0.000000D+00,  0.000000D+00,
     &   1.000000D+00,  0.000000D+00,  0.000000D+00,
     &   0.000000D+00,  1.000000D+00,  0.000000D+00,
     &   1.000000D+00,  1.000000D+00,  1.000000D+00 /

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_solid_angles_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_solid_angles() computes the solid angles'
      write ( *, '(a)' ) 
     &  '  associated with the vertices of a tetrahedron.'

      call r8mat_transpose_print ( 3, 4, t1, '  Tetrahedron #1' )
      call tetrahedron_solid_angles ( t1, angle )
      call r8vec_print ( 4, angle, '  Solid angles tetrahedron #1:' )
      
      call r8mat_transpose_print ( 3, 4, t2, '  Tetrahedron #2' )
      call tetrahedron_solid_angles ( t2, angle )
      call r8vec_print ( 4, angle, '  Solid angles tetrahedron #2:' )

      call r8mat_transpose_print ( 3, 4, t3, '  Tetrahedron #3' )
      call tetrahedron_solid_angles ( t3, angle )
      call r8vec_print ( 4, angle, '  Solid angles tetrahedron #3:' )

      call r8mat_transpose_print ( 3, 4, t4, '  Tetrahedron #4' )
      call tetrahedron_solid_angles ( t4, angle )
      call r8vec_print ( 4, angle, '  Solid angles tetrahedron #4:' )

      return
      end
      subroutine tetrahedron_volume_test ( )

c*********************************************************************72
c
cc tetrahedron_volume_test() tests tetrahedron_volume();
c
c  Licensing:
c
c    This code is distributed under the MIT license. 
c
c  Modified:
c
c    05 December 2006
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer dim_num
      parameter ( dim_num = 3 )

      double precision tetra(dim_num,4)
      save tetra
      data tetra /
     &   0.000000D+00,  0.942809D+00, -0.333333D+00,
     &  -0.816496D+00, -0.816496D+00, -0.333333D+00,
     &   0.816496D+00, -0.816496D+00, -0.333333D+00,
     &   0.000000D+00,  0.000000D+00,  1.000000D+00 /
      double precision volume

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'tetrahedron_volume_test():'
      write ( *, '(a)' ) 
     &  '  tetrahedron_volume() computes the volume of a tetrahedron.'

      call r8mat_transpose_print ( dim_num, 4, tetra, 
     &  '  Tetrahedron vertices' )

      call tetrahedron_volume ( tetra, volume )

      write ( *, '(a)' ) ''
      write ( *, '(a,g14.6)' ) '  Volume = ', volume

      return
      end
      subroutine timestamp ( )

c*********************************************************************72
c
cc timestamp() prints out the current YMDHMS date as a timestamp.
c
c  Licensing:
c
c    This code is distributed under the MIT license.
c
c  Modified:
c
c    12 June 2014
c
c  Author:
c
c    John Burkardt
c
      implicit none

      character * ( 8 ) ampm
      integer d
      character * ( 8 ) date
      integer h
      integer m
      integer mm
      character * ( 9 ) month(12)
      integer n
      integer s
      character * ( 10 ) time
      integer y

      save month

      data month /
     &  'January  ', 'February ', 'March    ', 'April    ', 
     &  'May      ', 'June     ', 'July     ', 'August   ', 
     &  'September', 'October  ', 'November ', 'December ' /

      call date_and_time ( date, time )

      read ( date, '(i4,i2,i2)' ) y, m, d
      read ( time, '(i2,i2,i2,1x,i3)' ) h, n, s, mm

      if ( h .lt. 12 ) then
        ampm = 'AM'
      else if ( h .eq. 12 ) then
        if ( n .eq. 0 .and. s .eq. 0 ) then
          ampm = 'Noon'
        else
          ampm = 'PM'
        end if
      else
        h = h - 12
        if ( h .lt. 12 ) then
          ampm = 'PM'
        else if ( h .eq. 12 ) then
          if ( n .eq. 0 .and. s .eq. 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