! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.53)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Naoki WATANABE, Nobutaka NISHIKAWA (Mizuho I.R.)   @@ !
! @@             Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine Spline__set( spline, vf, vx_out, N )
  use ac_parameter

  implicit none
  type(Spline_type), intent(out) :: spline
  integer, intent(in)       :: N
  real(8), intent(in)       :: vf(N)
  real(8), intent(in)       :: vx_out(N)

  real(8), allocatable :: vdx(:)
  real(8), allocatable :: vdf(:)
  real(8), allocatable ::  vu(:)
  integer       :: i

  spline%N = N 

  allocate( vdx(spline%N) )
  allocate( vdf(spline%N) )
  allocate(  vu(spline%N) )

  allocate( spline%vf(spline%N) )
  allocate( spline%vx(spline%N) )

  do i=1, spline%N
     spline%vf(i) = vf(i)
     spline%vx(i) = vx_out(i)
  end do

  allocate( spline%vb(spline%N) )
  allocate( spline%vc(spline%N) )
  allocate( spline%vd(spline%N) )

  do i=1, spline%N-1
     vdx(i) = vx_out(i+1) - vx_out(i+0)
  end do
  vdx(spline%N)=0.d0

  do i=1, spline%N-1
     vdf(i) = (vf(i+1)-vf(i))*(1.0/vdx(i))
  end do
  vdf(spline%N) = 0.d0

  spline%vc(1) = 0.d0
  do i=2, spline%N-1
     spline%vc(i) = (vdf(i+0)-vdf(i-1))*3.0
  end do
  spline%vc(spline%N) = 0.d0

  vu(1) = 0.d0
  do i=2, spline%N-1
     vu(i) = 1.0/( 2*(vdx(i+1)+vdx(i)) - vdx(i)*vdx(i)*vu(i-1) )
  end do
  vu(spline%N) = 0.d0

  do i=2, spline%N-1
     spline%vc(i) = spline%vc(i) - spline%vc(i-1)*(vdx(i-1)*vu(i-1))
  end do
  do i=spline%N-1, 2, -1
     spline%vc(i) = (spline%vc(i) - spline%vc(i+1)*vdx(i))*vu(i)
  end do

  do i=1, spline%N-1
     spline%vd(i) = (spline%vc(i+1)-spline%vc(i))*(1.0/(3.0*vdx(i)))
     spline%vb(i) = vdf(i) - spline%vc(i)*vdx(i) - spline%vd(i)*(vdx(i)*vdx(i))
  end do
  spline%vb(spline%N) = 0.d0
  spline%vd(spline%N) = 0.d0

  deallocate( vdx, vdf, vu )

  return
end subroutine Spline__set



subroutine Spline__reset( spline, vf )
  use ac_parameter

  implicit none
  type(Spline_type), intent(inout) :: spline
  real(8), intent(in)       :: vf(spline%N)


  real(8), allocatable :: vdx(:)
  real(8), allocatable :: vdf(:)
  real(8), allocatable ::  vu(:)
  integer       :: i

  allocate( vdx(spline%N) )
  allocate( vdf(spline%N) )
  allocate(  vu(spline%N) )

  do i=1, spline%N
     spline%vf(i) = vf(i)
  end do

  do i=1, spline%N-1
     vdx(i) = spline%vx(i+1) - spline%vx(i+0)
  end do
  vdx(spline%N)=0.d0

  do i=1, spline%N-1
     vdf(i) = (vf(i+1)-vf(i))*(1.0/vdx(i))
  end do
  vdf(spline%N) = 0.d0

  spline%vc(1) = 0.d0
  do i=2, spline%N-1
     spline%vc(i) = (vdf(i+0)-vdf(i-1))*3.0
  end do
  spline%vc(spline%N) = 0.d0

  vu(1) = 0.d0
  do i=2, spline%N-1
     vu(i) = 1.0/( 2*(vdx(i+1)+vdx(i)) - vdx(i)*vdx(i)*vu(i-1) )
  end do
  vu(spline%N) = 0.d0

  do i=2, spline%N-1
     spline%vc(i) = spline%vc(i) - spline%vc(i-1)*(vdx(i-1)*vu(i-1))
  end do
  do i=spline%N-1, 2, -1
     spline%vc(i) = (spline%vc(i) - spline%vc(i+1)*vdx(i))*vu(i)
  end do

  do i=1, spline%N-1
     spline%vd(i) = (spline%vc(i+1)-spline%vc(i))*(1.0/(3.0*vdx(i)))
     spline%vb(i) = vdf(i) - spline%vc(i)*vdx(i) - spline%vd(i)*(vdx(i)*vdx(i))
  end do
  spline%vb(spline%N) = 0.d0
  spline%vd(spline%N) = 0.d0

  deallocate( vdx, vdf, vu )

  return
end subroutine Spline__reset

subroutine Spline_deallocate(spline)
  use ac_parameter

  implicit none
  type(Spline_type) :: spline

  if( associated(spline%vx) ) deallocate(spline%vx)
  if( associated(spline%vf) ) deallocate(spline%vf)
  if( associated(spline%vb) ) deallocate(spline%vb)
  if( associated(spline%vc) ) deallocate(spline%vc)
  if( associated(spline%vd) ) deallocate(spline%vd)

  return
end subroutine Spline_deallocate

subroutine Spline__evaluate( spline, x, f )
  use ac_parameter

  implicit none
  type(Spline_type), intent(in)  :: spline
  real(8), intent(in) :: x

  real(8) :: f
  real(8) :: dx
  integer :: i, ia, ib, ic

  if( Param%Option%mx ) then
     call Spline__evaluateMX(spline,x,f)
     return
  end if

  if( x < spline%vx(1) ) then
     i=1
  elseif( x > spline%vx(spline%N) ) then
     i=spline%N
  else
     ia=1
     ib=spline%N
     do while( ia+1 < ib )
        ic = (ia+ib)/2
        if( x<spline%vx(ic) ) then
           ib=ic
        else
           ia=ic
        end if
     end do
     i=ia
  end if

  dx = x - spline%vx(i)

  f = spline%vf(i) + dx*(spline%vb(i) + dx*(spline%vc(i) + dx*spline%vd(i)))

  return
end subroutine Spline__evaluate

subroutine Spline__derivative( spline, x, df )
  use ac_parameter

  implicit none
  type(Spline_type), intent(in)  :: spline
  real(8), intent(in) :: x

  real(8) :: df

  integer       :: i, ia, ib, ic
  real(8) :: dx

  if( Param%Option%mx ) then
     call Spline__derivativeMX(spline,x,df)
     return
  end if

  if( x < spline%vx(1) ) then
     i=1
  elseif( x > spline%vx(spline%N) ) then
     i=spline%N
  else
     ia=1
     ib=spline%N
     do while( ia+1 < ib )
        ic = (ia+ib)/2
        if( x<spline%vx(ic) ) then
           ib=ic
        else
           ia=ic
        end if
     end do
     i=ia
  end if

  dx = x - spline%vx(i)

  df = spline%vb(i) + 2*dx*spline%vc(i) + 3*dx*dx*spline%vd(i)

  return
end subroutine Spline__derivative

subroutine Spline__evaluateMX( spline, x, f )
  use ac_parameter

  implicit none
  type(Spline_type), intent(in)  :: spline
  real(8), intent(in) :: x

  real(8) :: f
  integer :: i, ia, ib, ic
  real(8) :: h1,h2,h3,f1,f2,f3,f4
  real(8) :: g1,g2,x1,x2,y1,y2

  if( spline%vx(spline%N) < x ) then
     i=spline%N
  else if( x < spline%vx(1) ) then
     i=1
  else
     ia=1
     ib=spline%N
     do while( ia+1 < ib )
        ic = (ia+ib)/2
        if( x<spline%vx(ic) )then
           ib=ic
        else
           ia=ic
        end if
     end do
     i=ib
  end if

  if(i<2)then
     i = 3
  else if( spline%N<i )then
     i = spline%N-1
  end if

  if( i==2 ) then
     h2 = spline%vx(i)   - spline%vx(i-1)
     h3 = spline%vx(i+1) - spline%vx(i)

     f2 = spline%vf(i-1)
     f3 = spline%vf(i)
     f4 = spline%vf(i+1)

     h1 = -(h2+h3)
     f1 = f4
  else if (i==spline%N) then
     h1 = spline%vx(i-1) - spline%vx(i-2)
     h2 = spline%vx(i)   - spline%vx(i-1)

     f1 = spline%vf(i-2)
     f2 = spline%vf(i-1)
     f3 = spline%vf(i)

     h3 = -(h1+h2)
     f4 = f1
  else
     h1 = spline%vx(i-1) - spline%vx(i-2)
     h2 = spline%vx(i)   - spline%vx(i-1)
     h3 = spline%vx(i+1) - spline%vx(i)

     f1 = spline%vf(i-2)
     f2 = spline%vf(i-1)
     f3 = spline%vf(i)
     f4 = spline%vf(i+1)
  end if

  g1 = ((f3-f2)*h1/h2 + (f2-f1)*h2/h1)/(h1+h2)
  g2 = ((f4-f3)*h2/h3 + (f3-f2)*h3/h2)/(h2+h3)

  x1 = x - spline%vx(i-1)
  x2 = x - spline%vx(i)
  y1 = x1/h2
  y2 = x2/h2

  f = y2*y2*(3.0*f2 + h2*g1 + (2.0*f2 + h2*g1)*y2) &
       + y1*y1*(3.0*f3 - h2*g2 - (2.0*f3 - h2*g2)*y1)

  return
end subroutine Spline__evaluateMX

subroutine Spline__derivativeMX( spline, x, df )
  use ac_parameter

  implicit none
  type(Spline_type), intent(in)  :: spline
  real(8), intent(in) :: x

  real(8) :: df
  integer :: i, ia, ib, ic
  real(8) :: h1,h2,h3,f1,f2,f3,f4
  real(8) :: g1,g2,x1,x2,y1,y2

  if( spline%vx(spline%N) < x ) then
     i=spline%N
  else if( x < spline%vx(1) ) then
     i=1
  else
     ia=1
     ib=spline%N
     do while( ia+1 < ib )
        ic = (ia+ib)/2
        if( x<spline%vx(ic) )then
           ib=ic
        else
           ia=ic
        end if
     end do
     i=ib
  end if

  if(i<3)then
     i = 3
  else if( spline%N<i )then
     i = spline%N-1
  end if

  if( i==2 ) then
     h2 = spline%vx(i)   - spline%vx(i-1)
     h3 = spline%vx(i+1) - spline%vx(i)

     f2 = spline%vf(i-1)
     f3 = spline%vf(i)
     f4 = spline%vf(i+1)

     h1 = -(h2+h3)
     f1 = f4
  else if (i==spline%N) then
     h1 = spline%vx(i-1) - spline%vx(i-2)
     h2 = spline%vx(i)   - spline%vx(i-1)

     f1 = spline%vf(i-2)
     f2 = spline%vf(i-1)
     f3 = spline%vf(i)

     h3 = -(h1+h2)
     f4 = f1
  else
     h1 = spline%vx(i-1) - spline%vx(i-2)
     h2 = spline%vx(i)   - spline%vx(i-1)
     h3 = spline%vx(i+1) - spline%vx(i)

     f1 = spline%vf(i-2)
     f2 = spline%vf(i-1)
     f3 = spline%vf(i)
     f4 = spline%vf(i+1)
  end if

  g1 = ((f3-f2)*h1/h2 + (f2-f1)*h2/h1)/(h1+h2)
  g2 = ((f4-f3)*h2/h3 + (f3-f2)*h3/h2)/(h2+h3)

  x1 = x - spline%vx(i-1)
  x2 = x - spline%vx(i)
  y1 = x1/h2
  y2 = x2/h2

  df = y2*(2.0*(3.0*f2 + h2*g1) + 3.0*(2.0*f2 + h2*g1)*y2)/h2 &
       + y1*(2.0*(3.0*f3 - h2*g2) - 3.0*(2.0*f3 - h2*g2)*y1)/h2

  return
end subroutine Spline__derivativeMX

function Spline__size( spline ) result(N)
  use ac_parameter

  implicit none
  type(Spline_type), intent(in) :: spline

  integer      :: N

  N = spline%N

  return
end function Spline__size

function Spline__x(spline, i) result(x)
  use ac_parameter

  implicit none
  type(Spline_type), intent(in)  :: spline
  integer, intent(in)       :: i

  real(8) :: x

  x = spline%vx(i)

  return
end function Spline__x

function Spline__xfront(spline) result(x)
  use ac_parameter

  implicit none
  type(Spline_type), intent(in) :: spline
  real(8) :: x

  x = spline%vx(1)

  return
end function Spline__xfront

function Spline__xback(spline) result(x)
  use ac_parameter

  implicit none
  type(Spline_type), intent(in)  :: spline
  real(8) :: x

  x = spline%vx(spline%N)

  return
end function Spline__xback
