!
!  Light curves
!
!  Copyright © 2017-9 F.Hroch (hroch@physics.muni.cz)
!
!  This file is part of Munipack.
!
!  Munipack is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!
!  Munipack is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!
!  You should have received a copy of the GNU General Public License
!  along with Munipack.  If not, see <http://www.gnu.org/licenses/>.


module lcurves

  implicit none

  integer, parameter, private :: dbl = selected_real_kind(15)
  real(dbl), parameter, private :: pi = 3.1415926535897931_dbl

  type SplineSerieType
     real(dbl), dimension(:), allocatable :: time
     real(dbl), dimension(:,:), allocatable :: taaux
   contains
     procedure :: Init, Spline
  end type SplineSerieType

contains

  function wave(phi)

    real(dbl), intent(in) :: phi
    real(dbl) :: wave

    wave = cos(2*pi*phi) + 1

  end function wave

  ! delta Cep

  function delta_cep(phi)

    use lcparams

    real(dbl), intent(in) :: phi
    real(dbl) :: delta_cep

    delta_cep = fourfun(dcep,phi)

  end function delta_cep

  function beta_per(phi)

    use lcparams

    real(dbl), intent(in) :: phi
    real(dbl) :: beta_per

    beta_per = fourfun(algol,phi)

  end function beta_per

  function fourfun(c,phi)

    complex(dbl), dimension(0:), intent(in) :: c
    real(dbl), intent(in) :: phi
    real(dbl) :: fourfun,t
    complex(dbl) :: s,u,w
    integer :: j

    t = 2*pi*phi
    w = cmplx(cos(t),-sin(t),dbl)
    u = cmplx(1.0_dbl,0.0_dbl,dbl)
    s = 0.0_dbl
    do j = 0,size(c)-1
       s = s + c(j)*u
       u = u * w
    end do
    fourfun = real(s)

  end function fourfun


  subroutine Init(this,x,y,dy,sopt)

    class(SplineSerieType) :: this
    integer, parameter :: dbl = selected_real_kind(15)
    real(dbl), dimension(:), intent(in) :: x
    real(dbl), dimension(:), intent(in) :: y,dy
    real(dbl), intent(in) :: sopt

    real(dbl), external :: smooth
    real(dbl), dimension(:,:), allocatable :: aux, aaux

    integer :: n
    real(dbl) :: w,s,dnoise

    n = size(x)
    allocate(aux(n,7),aaux(n,4))
    allocate(this%time(n),this%taaux(4,n))

    ! approximate it
    dnoise = 1e-6       ! minimal error for spline fit (and display)

    ! interpolation
    s = epsilon(x)
    ! aproximation
    s = n

    if( sopt > 0 ) s = sopt

    w = smooth(x,y,max(dy,dnoise),size(x),s,aux,aaux)
    this%taaux = transpose(aaux(:,1:4))
    this%time = x

    ! block
    ! integer :: i
    !    open(1,file='l')
    !    do i = -100,200
    !       write(1,*) i/100.0,real(lcspline(i/100.0_dbl))
    !    end do
    !    close(1)
    ! end block

    deallocate(aux,aaux)

  end subroutine Init

  function Spline(this,t) result(f)

    class(SplineSerieType) :: this
    real(dbl), intent(in) :: t
    real(dbl) :: f
    integer :: n1
    real(dbl), external :: ppvalu

    n1 = size(this%time) - 1
    f = ppvalu(this%time,this%taaux,n1,4,t,0)

  end function Spline


end module lcurves
