program main

!****************************************************************************80
!
!! sparse_grid_mixed_size_test() tests sparse_grid_mixed_size().
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    21 December 2009
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Fabio Nobile, Raul Tempone, Clayton Webster,
!    A Sparse Grid Stochastic Collocation Method for Partial Differential
!    Equations with Random Input Data,
!    SIAM Journal on Numerical Analysis,
!    Volume 46, Number 5, 2008, pages 2309-2345.
!
  implicit none

  integer, parameter :: rk = kind ( 1.0D+00 )

  real ( kind = rk ) r8_epsilon
  real ( kind = rk ) tol

  call timestamp ( )
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'SPARSE_GRID_MIXED_SIZE_TEST'
  write ( *, '(a)' ) '  FORTRAN90 version'
!
!  Using a tolerance that is less than 0.0 means that there will be no
!  consolidation of duplicate points.
!
  tol = - 1.0D+00
  call sparse_grid_mixed_size_tests ( tol )
!
!  Using a small positive tolerance means there will be consolidation of
!  points whose maximum difference is no more than TOL.
!
  tol = sqrt ( r8_epsilon ( ) )
  call sparse_grid_mixed_size_tests ( tol )
!
!  Terminate.
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'SPARSE_GRID_MIXED_SIZE_TEST'
  write ( *, '(a)' ) '  Normal end of execution.'
  write ( *, '(a)' ) ' '
  call timestamp ( )

  stop 0
end
subroutine sparse_grid_mixed_size_tests ( tol )

!****************************************************************************80
!
!! SPARSE_GRID_MIXED_SIZE_TESTS calls SPARSE_GRID_MIXED_SIZE_TEST with various arguments.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    07 March 2011
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, real ( kind = rk ) TOL, a tolerance for point equality.
!    A value of sqrt ( eps ) is reasonable, and will allow the code to
!    consolidate points which are equal, or very nearly so.  A value of
!    -1.0, on the other hand, will force the code to use every point, regardless
!    of duplication.
!
  implicit none

  integer, parameter :: rk = kind ( 1.0D+00 )

  real ( kind = rk ), allocatable, dimension ( : ) :: alpha
  real ( kind = rk ), allocatable, dimension ( : ) :: beta
  integer dim_num
  integer level_max_max
  integer level_max_min
  integer, allocatable, dimension ( : ) :: order_1d
  integer order_nd
  integer, allocatable, dimension ( : ) :: rule
  real ( kind = rk ) tol

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'SPARSE_GRID_MIXED_SIZE_TESTS'
  write ( *, '(a)' ) '  Call SPARSE_GRID_MIXED_SIZE_TEST with various arguments.'
  write ( *, '(a,g14.6)' ) '  All tests will use a point equality tolerance of ', tol

  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 1, 1 /)
  alpha = (/ 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 1, 3 /)
  alpha = (/ 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 1, 4 /)
  alpha = (/ 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 1, 7 /)
  alpha = (/ 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 1, 8 /)
  alpha = (/ 0.0D+00, 1.5D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 2, 9 /)
  alpha = (/ 0.0D+00, 0.5D+00 /)
  beta = (/ 0.0D+00, 1.5D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 6, 4 /)
  alpha = (/ 2.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  dim_num = 3
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 1, 2, 5 /)
  alpha = (/ 0.0D+00, 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )
!
!  Dimension 2, Rule 13
!
  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 13, 13 /)
  alpha = (/ 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )
!
!  Dimension 2, Rule 16
!
  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 16, 16 /)
  alpha = (/ 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )
!
!  Dimension 2, Rule 17
!
  dim_num = 2
  level_max_min = 0
  level_max_max = 2
  allocate ( alpha(1:dim_num) )
  allocate ( beta(1:dim_num) )
  allocate ( rule(1:dim_num) )
  rule = (/ 17, 17 /)
  alpha = (/ 0.0D+00, 0.0D+00 /)
  beta = (/ 0.0D+00, 0.0D+00 /)
  call sparse_grid_mixed_size_test ( dim_num, level_max_min, level_max_max, rule, &
    alpha, beta, tol )
  deallocate ( alpha )
  deallocate ( beta )
  deallocate ( rule )

  return
end
subroutine sparse_grid_mixed_size_test ( dim_num, level_max_min, &
  level_max_max, rule, alpha, beta, tol )

!****************************************************************************80
!
!! SPARSE_GRID_MIXED_SIZE_TEST tests SPARSE_GRID_MIXED_SIZE.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    21 February 2010
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer DIM_NUM, the spatial dimension.
!
!    Input, integer LEVEL_MAX_MIN, LEVEL_MAX_MAX, the minimum and
!    maximum values of LEVEL_MAX.
!
!    Input, integer RULE(DIM_NUM), the rule in each dimension.
!     1, "CC",  Clenshaw Curtis, Closed Fully Nested.
!     2, "F2",  Fejer Type 2, Open Fully Nested.
!     3, "GP",  Gauss Patterson, Open Fully Nested.
!     4, "GL",  Gauss Legendre, Open Weakly Nested.
!     5, "GH",  Gauss Hermite, Open Weakly Nested.
!     6, "GGH", Generalized Gauss Hermite, Open Weakly Nested.
!     7, "LG",  Gauss Laguerre, Open Non Nested.
!     8, "GLG", Generalized Gauss Laguerre, Open Non Nested.
!     9, "GJ",  Gauss Jacobi, Open Non Nested.
!    10, "GW",  Golub Welsch, (presumed) Open Non Nested.
!    11, "CC_SE", Clenshaw Curtis Slow Exponential, Closed Fully Nested.
!    12, "F2_SE", Fejer Type 2 Slow Exponential, Closed Fully Nested.
!    13, "GP_SE", Gauss Patterson Slow Exponential, Closed Fully Nested.
!    14, "CC_ME", Clenshaw Curtis Moderate Exponential, Closed Fully Nested.
!    15, "F2_ME", Fejer Type 2 Moderate Exponential, Closed Fully Nested.
!    16, "GP_ME", Gauss Patterson Moderate Exponential, Closed Fully Nested.
!    17, "CCN", Clenshaw Curtis Nested, Linear, Closed Fully Nested rule.
!
!    Input, real ( kind = rk ) ALPHA(DIM_NUM), BETA(DIM_NUM), parameters used for
!    Generalized Gauss Hermite, Generalized Gauss Laguerre, and Gauss Jacobi rules.
!
!    Input, real ( kind = rk ) TOL, a tolerance for point equality.
!
  implicit none

  integer, parameter :: rk = kind ( 1.0D+00 )

  integer dim_num

  real ( kind = rk ) alpha(dim_num)
  real ( kind = rk ) beta(dim_num)
  integer dim
  integer level_max
  integer level_max_max
  integer level_max_min
  integer level_min
  integer point_num
  integer point_total_num
  integer rule(dim_num)
  real ( kind = rk ) tol

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'SPARSE_GRID_MIXED_SIZE_TEST'
  write ( *, '(a)' ) '  SPARSE_GRID_MIXED_SIZE returns the number of distinct'
  write ( *, '(a)' ) '  points in a multidimensional sparse grid with mixed factors.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  SPARSE_GRID_MIXED_SIZE_TOTAL returns the TOTAL number of'
  write ( *, '(a)' ) '  points in a multidimensional sparse grid with mixed factors,'
  write ( *, '(a)' ) '  without checking for duplication.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Each sparse grid is of spatial dimension DIM_NUM,'
  write ( *, '(a)' ) '  and is made up of product grids of levels up to LEVEL_MAX.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) ' Dimension      Rule     Alpha          Beta'
  write ( *, '(a)' ) ' '

  do dim = 1, dim_num
    if ( rule(dim) ==  1 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  2 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  3 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  4 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  5 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  6 ) then
      write ( *, '(2x,i8,2x,i8,2x,g14.6)' ) &
        dim, rule(dim), alpha(dim)
    else if ( rule(dim) ==  7 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  8 ) then
      write ( *, '(2x,i8,2x,i8,2x,g14.6)' ) &
        dim, rule(dim), alpha(dim)
    else if ( rule(dim) ==  9 ) then
      write ( *, '(2x,i8,2x,i8,2x,g14.6,2x,g14.6)' ) &
        dim, rule(dim), alpha(dim), beta(dim)
    else if ( rule(dim) ==  10 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  11 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  12 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  13 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  14 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  15 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  16 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else if ( rule(dim) ==  17 ) then
      write ( *, '(2x,i8,2x,i8)' ) &
        dim, rule(dim)
    else
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'SPARSE_GRID_MIXED_SIZE_TEST - Fatal error!'
      write ( *, '(a,i8)' ) '  Unexpected value of RULE = ', rule(dim)
      stop
    end if
  end do

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) ' LEVEL_MIN LEVEL_MAX POINT_NUM POINT_NUM'
  write ( *, '(a)' ) '                        Unique     Total'
  write ( *, '(a)' ) ' '

  do level_max = level_max_min, level_max_max

    call sparse_grid_mixed_size_total ( dim_num, level_max, rule, &
      point_total_num )

    call sparse_grid_mixed_size ( dim_num, level_max, rule, alpha, beta, &
      tol, point_num )

    level_min = max ( 0, level_max + 1 - dim_num )

    write ( *, '(2x,i8,2x,i8,2x,i8,2x,i8)' ) &
      level_min, level_max, point_num, point_total_num

  end do

  return
end