
program testrfactor

  use oakleaf
  use noise
  use toolbox
  use testsuite

  implicit none

  integer, parameter :: rp = selected_real_kind(15)
  character(len=15), parameter :: fmt = '(a,l3)'
  integer :: voltage

  call randomnoise

  call get_environment_variable("VOLTAGE",status=voltage)

  if( .not. (voltage == 0) ) then

     call tester(build)

  else

!     call tester(poisson3)
     call single
     call identity
     call tester(bmuma)
     call tester(poisson1)
     call tester(poisson2)

  end if


contains


  subroutine build

    real(rp), dimension(:), allocatable :: x,dx,y,dy
    type(suite) :: poi
    logical :: cond

    integer :: n,l
    real(rp) :: mean

    mean = 10**6

    n = 10**4
    allocate(x(n),dx(n),y(n),dy(n))

    do l = 1, n
       x(l) = pnoise(mean)
       y(l) = pnoise(mean)
    end do

    write(*,*) 'Po(10**6)  n=',n
    dx = sqrt(x)
    dy = sqrt(y)
    call poi%poistat(x,dx,y,dy)
    cond = abs(poi%t - 1) < 5*poi%dt
    write(*,'(a,l2)') 'TEST build PASS:',cond
    write(*,*)
    deallocate(x,dx,y,dy)

  end subroutine build


  subroutine poisson1

    real(rp), dimension(:), allocatable :: x,dx,y,dy
    type(suite) :: std, rob, qt, stdw, robw, poi
    logical :: cond

    integer :: m,n,l
    real(rp) :: mean, fac

    mean = 10**4
    fac = 4

    do m = 1,6
       n = 10**m
       allocate(x(n),dx(n),y(n),dy(n))

       do l = 1, n
          x(l) = pnoise(mean)
          y(l) = pnoise(mean/fac)
       end do

       write(*,*) 'Po(10**6)  n=',n
       call std%stdstat(x/y)
       call rob%robstat(x/y)
       call qt%qtstat(x/y)

       dx = sqrt(x)
       dy = sqrt(y)
!       dx = 1
!       dy = 1
       call stdw%stdwstat(x/y,sqrt(dx**2 + fac**2*dy**2))
       call robw%robwstat(x/y,sqrt(dx**2 + fac**2*dy**2))
       call poi%poistat(x,dx,y,dy)
       cond = abs(poi%t - fac) < 5*poi%dt
       write(*,'(a,i0,a,l2)') 'TEST poisson1(',n,') PASS:',cond
       write(*,*)
       deallocate(x,dx,y,dy)
    end do

  end subroutine poisson1

  subroutine poisson2

    real(rp), dimension(:), allocatable :: x,dx,y,dy
    type(suite) :: std, rob, qt, stdw, robw, poi
    logical :: cond

    integer :: m,n,l,k
    real(rp) :: mean, fac

    mean = 10**4
    fac = 4

    do m = 1,6
       n = 10**m
       allocate(x(n),dx(n),y(n),dy(n))

       k = int(0.9*n)
       do l = 1, k
          x(l) = pnoise(mean)
          y(l) = pnoise(mean/fac)
       end do
       do l = k+1, n
          x(l) = pnoise(mean)
          y(l) = pnoise(10*mean)
       end do

       write(*,*) '0.9*Po(10000)+0.1*Po(10**5)  n=',n
       call std%stdstat(x/y)
       call rob%robstat(x/y)
       call qt%qtstat(x/y)

       dx = sqrt(x)
       dy = sqrt(y)
       call stdw%stdwstat(x/y,sqrt(dx**2 + fac**2*dy**2))
       call robw%robwstat(x/y,sqrt(dx**2 + fac**2*dy**2))
       call poi%poistat(x,dx,y,dy)
       cond = abs(poi%t - fac) < 5*poi%dt
       write(*,'(a,i0,a,l2)') 'TEST poisson2(',n,') PASS:',cond
       write(*,*)
       deallocate(x,dx,y,dy)
    end do

  end subroutine poisson2

  subroutine poisson3

    real(rp), dimension(:), allocatable :: x,dx,y,dy
    type(suite) :: poi
    logical :: cond

    integer :: m,n,l
    real(rp) :: mean, fac

    mean = 8
    fac = 4

    do m = 1,6
       n = 10**m
       allocate(x(n),dx(n),y(n),dy(n))

       do l = 1, n
          x(l) = pnoise(mean)
          y(l) = pnoise(mean/fac)
       end do

       write(*,*) 'Po(8)  n=',n
       dx = 1
       dy = 1
       call poi%poistat(x,dx,y,dy)
       cond = abs(poi%t - fac) < 5*poi%dt
       write(*,'(a,i0,a,l2)') 'TEST poisson3(',n,') PASS:',cond
       write(*,*)
       deallocate(x,dx,y,dy)
    end do

  end subroutine poisson3

  subroutine bmuma

    real(rp), dimension(6) :: x,dx,y,dy
    type(suite) :: std, rob, qt, stdw, robw, poi
    logical :: cond

    x = [1.58682E+07, 4.53635E+05, 4.41066E+05, 4.14017E+05, &
         4.55078E+05, 3.11341E+05]
    dx = [ 3.990E+03, 712., 704., 682., 713., 608. ]
    y = [ 1.51535E+06, 44100., 42143., 39892., 42909., 30737. ]
    dy = [ 1.233E+03, 221., 216., 209., 218., 189. ]

    write(*,*) 'BM UMa'
    call std%stdstat(x/y)
    call rob%robstat(x/y)
    call qt%qtstat(x/y)

    call stdw%stdwstat(x/y,sqrt(dx**2 + dy**2))
    call robw%robwstat(x/y,sqrt(dx**2 + dy**2))
    call poi%poistat(x,dx,y,dy)
    cond = abs(poi%t - 10.463) < 5*poi%dt
    write(*,'(a,l2)') 'TEST bmuma PASS:',cond
    write(*,*)

  end subroutine bmuma

  subroutine single

    real, dimension(6) :: x,dx,y,dy
    real :: t,dt,s,c
    integer :: flag

    x = [1.58682E+07, 4.53635E+05, 4.41066E+05, 4.14017E+05, &
         4.55078E+05, 3.11341E+05]
    dx = [ 3.990E+03, 712., 704., 682., 713., 608. ]
    y = [ 1.51535E+06, 44100., 42143., 39892., 42909., 30737. ]
    dy = [ 1.233E+03, 221., 216., 209., 218., 189. ]

    call fmean(x,dx,y,dy,t,dt,s,c,flag=flag)
    write(*,*) 'Single precision: ',t,dt,s,c,flag

  end subroutine single

  subroutine identity

    real(rp), dimension(:), allocatable :: x,dx,y,dy
    type(suite) :: poi
    logical :: cond

    integer :: n,l
    real(rp) :: mean

    mean = 10**2

    n = 10
    allocate(x(n),dx(n),y(n),dy(n))

    do l = 1, n
       x(l) = max(pnoise(mean),1d-3)
    end do
    dx = sqrt(x)
    y = x
    dy = dx

    write(*,*) 'Po(10**2)  n=',n
    call poi%poistat(x,dx,y,dy)
    cond = abs(poi%t - 1) < 5*epsilon(poi%t)
    write(*,'(a,l2)') 'TEST identity PASS:',cond
    write(*,*)
    deallocate(x,dx,y,dy)

  end subroutine identity


end program testrfactor
