module operators

  ! Implements various operators

  implicit none
  integer, parameter, private :: r8 = selected_real_kind(12,100)
  complex(r8), parameter, private :: imag = (0._r8, 1._r8)
  character(*), parameter, private :: version = &
       & '$Id: operators.f90,v 1.6 2003/10/23 13:12:51 pletzer Exp $'

contains

  subroutine second_derivative(x, ak, z, sigma, res, ier)

    ! Returns the derivative of order 'order' / Gabor

    implicit none
    real(r8), intent(in) :: x, ak, z, sigma
    complex(r8), intent(out) :: res
    integer, intent(out) :: ier

    ier = 0
    res = (imag*ak - sigma*(x-z))**2 - sigma

  end subroutine second_derivative

  subroutine derivative(order, x, ak, z, sigma, res, ier)

    implicit none
    integer, intent(in) :: order
    real(r8), intent(in) :: x, ak, z, sigma
    complex(r8), intent(out) :: res
    integer, intent(out) :: ier

    real(r8) :: s

    s = sigma
    ier = 0
    select case (order)
    case(:-1)
       ier = 1
       res = -huge(1._r8) 
    case(0)
       res = 1
    case(1)
       res = (0,1)*ak + s*(-x + z)
    case(2)
       res = -s - (ak + (0,1)*s*(x - z))**2
    case(3)
       res = ((0,1)*ak + s*(-x + z))*(-3*s + ((0,1)*ak + s*(-x + z))**2)
    case(4)
       res = 3*s**2 + (ak + (0,1)*s*(x - z))**4 - 6*s*((0,-1)*ak + s*(x - z))**2
    case(5)
       res =          (15*s**2 + (ak + (0,1)*s*(x - z))**4 -  &
            & 10*s*((0,-1)*ak + s*(x - z))**2)*((0,1)*ak + s*(-x + z))

    case(6)
       res =          -15*s**3 - 15*s*(ak + (0,1)*s*(x - z))**4 +  &
            &  45*s**2*((0,-1)*ak + s*(x - z))**2 + ((0,1)*ak + s*(-x + z))**6

    case(7)
       res =          ((0,1)*ak + s*(-x + z))* &
            &  (-105*s**3 - 21*s*(ak + (0,1)*s*(x - z))**4 + &
            & 105*s**2*((0,-1)*ak + s*(x - z))**2 + ((0,1)*ak + s*(-x + z))**6)

    case(8)
       res =          105*s**4 + 210*s**2*(ak + (0,1)*s*(x - z))**4 + &
            &   (ak + (0,1)*s*(x - z))**8 - 420*s**3*((0,-1)*ak + s*(x - z))**2 - &
            &   28*s*((0,-1)*ak + s*(x - z))**6

    case(9)
       res =          (945*s**4 + 378*s**2*(ak + (0,1)*s*(x - z))**4 + &
            & (ak + (0,1)*s*(x - z))**8 - 1260*s**3*((0,-1)*ak + s*(x - z))**2 - &
            & 36*s*((0,-1)*ak + s*(x - z))**6)*((0,1)*ak + s*(-x + z))

    case(10)
       res =          -945*s**5 - 3150*s**3*(ak + (0,1)*s*(x - z))**4 - &
            &   45*s*(ak + (0,1)*s*(x - z))**8 + &
            &   4725*s**4*((0,-1)*ak + s*(x - z))**2 + &
            &   630*s**2*((0,-1)*ak + s*(x - z))**6 + ((0,1)*ak + s*(-x + z))**10

    case default
       ! not implemented
       ier = 2
       res = + huge(1._r8)
    end select
  end subroutine derivative


  subroutine curl_curl(ia, ib, x, ak, z, sigma, res, ier)

    implicit none
    integer, intent(in) :: ia, ib ! field components
    real(r8), intent(in) :: x(:) ! collocation position
    real(r8), intent(in) :: ak(:) ! Gabor wave-vector
    real(r8), intent(in) :: z(:) ! Gabor envelop position
    real(r8), intent(in) :: sigma(:) ! inverse Gabor extents
    complex(r8), intent(out) :: res ! result
    integer, intent(out) :: ier

    complex(r8) :: i_ktilde(size(x))

    ier = 0
    i_ktilde = imag*ak - sigma*(x-z)
    res = i_ktilde(ia)*i_ktilde(ib)
    if(ia==ib) then
       res = res - sigma(ia) - dot_product(i_ktilde,i_ktilde) &
            & + sum(sigma)
    endif
    
  end subroutine curl_curl

  

end module operators
