
program eparam

  use fmm
  use iromberg

  implicit none
  integer, parameter :: kind = selected_real_kind(15)
  real(kind), parameter :: pi = 4.0_kind*atan(1.0_kind)

  real(kind) :: a,b,tol,s
  integer :: flag

!  a = 0
!  b = 2*atan(1.0_kind)
!  tol = 1e-10
!  write(*,*) romberg(rtest,a,b,tol,iflag=flag),flag
!  stop 0

  a = 0.5
  b = 2
  tol = 1e-7

  s = fmin(a,b,negentropy_gauss,tol)
  write(*,'(a,2f7.4)') "Maximum of entropy for Normal distribution:",s,s**2

  s = fmin(a,b,negentropy_huber,tol)
  write(*,'(a,2f7.4)') "Maximum of entropy for Huber's minimax:",s,s**2

  s = fmin(a,b,negentropy_tukey,tol)
  write(*,'(a,2f7.4)') "Maximum of entropy for Tukey's biweight:",s,s**2

!  write(*,'(a,2f7.4)') "Effective beta for Tukey**2:",beta_tukey2()
!  write(*,'(a,2f7.4)') "Effective beta for Tukey*Normal:",beta_tukeynorm()

  a = -6
  b = 6
  tol = 1e-5
  write(*,*) "Normalisation for Tukey:", norm_tukey(), &
       romberg(fun_tukey,a,b,tol,iflag=flag)

  a = 0
  b = 7
  write(*,*) "Effective beta for Tukey**2:",beta_tukey2(), &
       romberg(sig_tukey,a,b,tol,iflag=flag)

contains

  function negentropy_gauss(x)

    use rfun

    real(kind) :: negentropy_gauss
    real(kind), intent(in) :: x

    negentropy_gauss = - x**2/2*exp(-x**2/2)

  end function negentropy_gauss

  function negentropy_huber(x)

    use rfun
    real(kind) :: negentropy_huber
    real(kind), intent(in) :: x

    negentropy_huber = - ihuber(x)*exp(-ihuber(x))

  end function negentropy_huber

  function negentropy_tukey(x)

    use rfun
    real(kind) :: negentropy_tukey
    real(kind), intent(in) :: x

    negentropy_tukey = - itukey(x)*exp(-itukey(x))

  end function negentropy_tukey


  function beta_tukey2() result(beta)

    use rfun
    real(kind) :: x, s, snorm, beta
    integer :: i

    s = 0
    snorm = 0
    do i = 0, 600000
       x = i / 1e5
       s = s + tukey(x)**2*exp(-itukey(x))
!       snorm = snorm + exp(-tukey(x)**2/2)
!       s = s + itukey(x)*exp(-itukey(x))
       snorm = snorm + exp(-itukey(x))
!       s = s + x**2*exp(-x**2/2)
!       snorm = snorm + exp(-x**2/2)

    end do
!    snorm = sqrt(2*pi)
    beta = s  / snorm !/ 1e5

  end function beta_tukey2

  function beta_tukeynorm() result(beta)

    use rfun
    real(kind) :: x, s, snorm, beta
    integer :: i

    s = 0
    snorm = 0
    do i = 0, 10*600000
       x = i / 1e6
       !s = s + 2*tukey(x)*x*exp(-itukey(x))
       !snorm = snorm + exp(-itukey(x))
       s = s + x**2*exp(-x**2/2)
!       snorm = snorm +
    end do
    beta = 2 * s / sqrt(2*pi) !/ snorm

  end function beta_tukeynorm

  function norm_tukey() result(gama)

    use rfun

    real(kind) :: x, s, gama
    integer :: i

    s = 0
    do i = 0, 600000
       x = i / 1e5
       s = s + exp(-itukey(x))
!       s = s + exp(-tukey(x)**2/2)
!       s = s + exp(-x**2/2)
    end do
    gama = 2 * s / 1e5

  end function norm_tukey

  function fun_tukey(x) result(f)

    use rfun

    real(kind) :: f
    real(kind), intent(in) :: x

    if( abs(x) <= 6 ) then
       f = exp(-itukey(x)) !/ 3.73253078 !/ 2.6496858221126
!       f = exp(-x**2/2) !/ sqrt(2*pi)
!       f = exp(-tukey(x)**2/2)
    else
       f = 0
    end if

  end function fun_tukey

  function sig_tukey(x) result(f)

    use rfun

    real(kind) :: f
    real(kind), intent(in) :: x

    if( abs(x) <= 6 ) then
!       f = itukey(x)*exp(-itukey(x)) / 3.73253078
!       f = tukey(x)**2*exp(-itukey(x)) / 3.73253078
       f = x**2*exp(-x**2/2) / sqrt(2*pi)
    else
       f = 0
    end if
    f = x**2* exp(-x**2/2) / sqrt(2*pi)

  end function sig_tukey

  function rtest(x) result(f)

    use rfun

    real(kind) :: f
    real(kind), intent(in) :: x

    f = sin(x)
    return

  end function rtest

end program eparam
