module mod_kepler
  use image_def
  type(gildas) :: hvelo
  !
  integer :: kep_nchan=0
  integer :: kep_nrad=0
  !
  logical :: kepler_setup=.true.
  real(8) :: kepler_x0 = 0.
  real(8) :: kepler_y0 = 0.
  real(8) :: kepler_rota = 0.
  real(8) :: kepler_incli= 30.
  real(8) :: kepler_vmass= 2.5
  real(8) :: kepler_vdisk= 0.
  real(8) :: kepler_rint=50.
  real(8) :: kepler_rout=500.
  real(8) :: kepler_rmax=800.
  real(8) :: kepler_dist=150.
  real(8) :: kepler_step=50.
  real(8) :: kepler_theta=60.
  !
  real(8), allocatable :: kep_spectrum(:,:)
  real(8), allocatable :: kep_profile(:,:)
  real(8), allocatable :: kep_spectra(:,:)
  !
end module mod_kepler
!
subroutine kepler_comm(line,comm,error)
  use gkernel_types
  use gkernel_interfaces
  use imager_interfaces, only : sub_readhead, map_message
  use clean_arrays
  use gbl_message
  use mod_kepler
!-----------------------------------------------------------------------
! @ private
! IMAGER
!
!   Support for command
!   KEPLER
!
! Input parameters
!     KEPLER%X0   KEPLER%Y0     Center of disk (arcsec)
!     KEPLER%ROTA KEPLER%INCLI  Orientation, Inclination in °
!     KEPLER%VMASS              Rotation velocity at 100 au (km/s)
!     KEPLER%VDISK              Disk velocity (km/s)
!     KEPLER%DIST               Distance (pc)
!     KEPLER%ROUT               Outer radius (au)
!     KEPLER%RINT               Inner radius (au)
!     KEPLER%RMAX               Maximum radius (au)
!     KEPLER%STEP               Radial sampling (au)
!     KEPLER%THETA              Maximum angle from major axis in °
! Input data
!     CLEAN Image (so far)
! Output data
!     Integrated spectral line profile, with error bars
!     Radial profile at line center
!
! Open issues:
!     Should the profile be radially weighted ?
!     How ?
!-----------------------------------------------------------------------
  character(len=*), intent(in) :: line
  character(len=*), intent(in) :: comm
  logical, intent(out) :: error
  !
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='KEPLER'
  !
  character(len=filename_length) :: stype
  integer :: ns
  integer(kind=4), save :: memory(2)
  integer(kind=address_length) :: ipstat
  !
  type(gildas) :: hmap
  real, allocatable :: data(:,:,:)
  logical :: is_image, rdonly
  !
  integer :: i,ier
  !
  error = .false.
  if (kepler_setup) then
    call kepler_init(error)
    if (error) then
      call map_message(seve%e,rname,'Initialisation error, remove all KEPLER* variables')
      return
    endif
  endif
  !
  stype = 'CLEAN'
  if (sic_narg(0).eq.1) then
    call sic_ch(line,0,1,stype,ns,.true.,error)
    if (error) return
    if (stype.eq.'?') then
      call exec_program('@ i_kepler') 
      return
    endif
  endif
  !
  call sic_delvariable ('KEPLER_SPECTRUM',.false.,error)
  call sic_delvariable ('KEPLER_PROFILE',.false.,error)
  call sic_delvariable ('KEPLER_SPECTRA',.false.,error)
  call sic_delvariable ('KEPLER_VELO',.false.,error)
  error = .false.
  if (kep_nchan.ne.0) then
    deallocate(kep_profile,kep_spectrum,kep_spectra,hvelo%r2d)
    kep_nchan = 0
    kep_nrad = 0
  endif
  call gildas_null(hvelo)
  !
  ! Read the Image / Data file header
  call gildas_null(hmap)
  is_image = .false.
  rdonly = .true.
  call sub_readhead(rname,stype,hmap,is_image,error,rdonly,fmt_r4)
  if (error) return
  !
  ! Verify shape conformance
  if ((hmap%gil%ndim.ne.3).or.(hmap%gil%faxi.ne.3)) then
    call map_message(seve%e,rname,trim(stype)//' is not a LMV cube')
    error = .true.
    return
  endif
  !
  if (.not.is_image) then
    allocate(data(hmap%gil%dim(1),hmap%gil%dim(2),hmap%gil%dim(3)),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Data cube allocation error')
      error = .true.
      return
    endif
    call gdf_read_data(hmap,data,error)
    if (error) then
      call map_message(seve%e,rname,'Data cube read error')
      error = .true.      
      return
    endif
    hmap%loca%addr = locwrd(data)
  endif
  ipstat = gag_pointer(hmap%loca%addr,memory)
  !
  ! Do the job
  call kepler_compute(hmap,memory(ipstat),error)
  !
  ! Free the input data file if any
  if (.not.is_image) call gdf_close_image(hmap,error)
end subroutine kepler_comm

subroutine kepler_compute(hmap,data,error)
  use gkernel_types
  use gkernel_interfaces
  use imager_interfaces, except_this => kepler_compute
  use clean_arrays
  use gbl_message
  use mod_kepler
!-----------------------------------------------------------------------
! @ private
! IMAGER
!
!   Support for command
!   KEPLER
!
! Input parameters
!     KEPLER%X0   KEPLER%Y0     Center of disk (arcsec)
!     KEPLER%ROTA KEPLER%INCLI  Orientation, Inclination in °
!     KEPLER%VMASS              Rotation velocity at 100 au (km/s)
!     KEPLER%VDISK              Disk velocity (km/s)
!     KEPLER%DIST               Distance (pc)
!     KEPLER%ROUT               Outer radius (au)
!     KEPLER%RINT               Inner radius (au)
!     KEPLER%RMAX               Maximum radius (au)
!     KEPLER%STEP               Radial sampling (au)
!     KEPLER%THETA              Maximum angle from major axis in °
! Input data
!     A 3-D Gildas Image (in memory) 
! Output data
!     Integrated spectral line profile, with error bars
!     Radial profile at line center
!     Spectral profiles as a function of radius, with error bars
!
! Open issues:
!     Should the profile be radially weighted ?     How ?
!-----------------------------------------------------------------------
  type(gildas), intent(inout) :: hmap
  real, intent(in) :: data(hmap%gil%dim(1),hmap%gil%dim(2),hmap%gil%dim(3))
  logical, intent(out) :: error
  !
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  character(len=*), parameter :: rname='KEPLER'
  !
  real(8) :: cospa, sinpa, cosi, sini
  real(8) :: offx, offy, offmax, offmin, sec
  real(8) :: xoff, yoff, roff, voff
  real(8) :: xinc, yinc, xval, yval, xref, yref
  real :: bval, rstep
  integer(kind=index_length) :: nn, xdim, ydim, ic1, icn
  real, allocatable :: x(:,:), y(:,:), s(:,:), t(:), r(:), v(:)
  integer, allocatable :: n(:,:), m(:)
  real, allocatable :: rwork(:,:)
  integer, allocatable :: iwork(:,:)
  logical :: blanked, do_peak
  integer :: ix, jy, iv, kv, k, is, ie, ier, istep, nstep, mstep
  integer :: nx, ny, nv, iloc(1)
  real :: radius, theta, thetamax, vproj, vsini
  real :: kperjy, jyperk, beam_area, factor, z
  integer(kind=address_length) :: dim(2)
  !
  sec = pi/180/3600   ! Second to Radian
  !
  if (sic_varexist('KEPLER_VDISK')) then
    call sic_get_dble('KEPLER_VDISK',kepler_vdisk,error) 
    do_peak  = .false.
  else
    do_peak = .true.
  endif
  !
  call gdf_copy_header(hmap,hvelo,error)
  if (error) return
  hvelo%gil%ndim = 2
  hvelo%gil%dim(3) = 1
  hvelo%gil%convert(:,3) = 1.
  hvelo%char%unit = 'km/s'
  !
  thetamax = kepler_theta*pi/180
  !
  cospa = cos(pi*kepler_rota/180)
  sinpa = sin(pi*kepler_rota/180)
  sini = sin(kepler_incli*pi/180)
  cosi = cos(kepler_incli*pi/180)
  !
  vsini = kepler_vmass * sini
  !
  rstep = (kepler_rout-kepler_rint)/kepler_step
  nstep = int(rstep)
  if (real(nstep).ne.rstep) nstep = nstep+1
  !
  ! Add a few steps beyond to compute the radial profile
  mstep = nstep+5
  kepler_rmax = kepler_rint+mstep*kepler_step
  !
  ! Or more if needed
  call sic_get_dble('KEPLER_RMAX',kepler_rmax,error)
  if (kepler_rmax.lt.kepler_rout) kepler_rmax = kepler_rout
  mstep =   nint((kepler_rmax-kepler_rint)/kepler_step)
  !
  offmin = kepler_rint/kepler_dist*sec
  offmax = (kepler_rint + mstep*kepler_step)/kepler_dist*sec 
  Print *,'NSTEP ',nstep,kepler_step,kepler_rint,kepler_rout,kepler_rmax
  Print *,'Offmin ',offmin, offmin/sec*kepler_dist
  !
  yinc = hmap%gil%inc(3)
  yref = hmap%gil%ref(3)
  yval = hmap%gil%val(3)
  !
  xref = yref
  xinc = yinc
  xdim = hmap%gil%dim(3)
  ydim = xdim
  ic1 = 1
  icn = hmap%gil%dim(3)
  nn = 1
  !
  allocate (x(1,xdim),y(1,ydim),s(xdim,mstep),n(xdim,mstep), &
    & t(xdim), r(xdim), m(xdim), v(xdim), iwork(2,xdim),  &
    & rwork(4,xdim), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation failure')
    error = .true.
    return
  endif
  !
  ! Radial sampling
  do is=1,mstep
    r(is) = kepler_rint + kepler_step*(is-0.5)
  enddo
  nx = hmap%gil%dim(1)
  ny = hmap%gil%dim(2)
  nv = hmap%gil%dim(3) 
  Print *,'NX,NY,NV ',nx,ny,nv 
  !
  s = 0.
  n = 1
  !
  allocate(hvelo%r2d(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation failure')
    error = .true.
    return
  endif
  !
  bval = -1000.0
  do jy=1,ny
    offy = (jy-hmap%gil%ref(2))*hmap%gil%inc(2) + hmap%gil%inc(2) - kepler_y0
    !!Print *,'JY ',jy,offy,offmax
    if (abs(offy).gt.offmax) cycle
    !
    do ix=1,nx
      !!Print *,'IX ',ix
      !
      offx = (ix-hmap%gil%ref(1))*hmap%gil%inc(1) + hmap%gil%inc(1)
      if (abs(offx).gt.offmax) cycle
      !
      ! Apply rotation Matrix an Deproject Y axis
      xoff = offx*cospa-offy*sinpa
      yoff = (offx*sinpa+offy*cospa) /cosi
      !
      ! Apply Kepler Shift
      roff = sqrt(xoff**2+yoff**2)         ! Radial distance in radians
      radius = roff*kepler_dist/sec        ! Radial distance in au
      !
      if (radius.ne.0) then
        theta = atan2(yoff,xoff)           ! Polar angle
        vproj = vsini/sqrt(radius/100)*cos(theta) ! Line of sight velocity offset
        theta = abs(atan(yoff/xoff))       ! Absolute polar angle      
      endif
      hvelo%r2d(ix,jy) = -vproj            ! Remember the velocity
      !
      if (roff.gt.offmax) cycle            !
      if (roff.lt.offmin) cycle
!!        Print *,'Roff ',roff,' < ',offmin,roff*kepler_dist/sec      ! Radial distance in au
!!        cycle
!!      endif
      if (theta.gt.thetamax) then
        !! Print *,'ix,jy ',ix,jy,' Theta ',theta,' > ',thetamax
        cycle
      endif
      !
      ! Subtract this velocity to that of the spectrum...
      xval = yval - vproj
      !! Print *,'Velocities ',xval,yval,vproj
      !
      ! Interpolate the values
      y(1,:) = data(ix,jy,:)  ! Input array
      x(1,:) = 0.0            ! Output array
      blanked = .false.     
      call all_inter (nn,ic1,icn,x,xdim,xinc,xref,xval, &
        & y,ydim,yinc,yref,yval,bval,blanked,iwork,rwork)
      !
      ! Add them to the appropriate radial range
      istep = nint((radius-kepler_rint)/kepler_step + 0.5)
      if (istep.ge.1 .and. istep.le.mstep) then
        !! Print *,'Adding ',ix,jy,' at ',istep, radius
        !
        do kv = 1,ydim 
          if (x(1,kv).ne.bval .and. s(kv,istep).ne.bval) then
            s(kv,istep) = s(kv,istep) + x(1,kv)
            n(kv,istep) = n(kv,istep) + 1
          else
            s(kv,istep) = bval
            n(kv,istep) = 0
          endif
        enddo
      endif
    enddo
  enddo
  !
  ! Normalize to get the Mean Brightness for each radius
  where (n.gt.1) s = s/(n-1) 
  !
  t = 0
  m = 1
  call get_jyperk(hmap,beam_area,jyperk)
  !
  ! Convert mean "brightness" to integrated flux
  ! If we want to get the flux, we shall multiply by the area
  !   of each radius, including the Azimuth range. 
  !
  ! Actually, to get the flux, we should divide by the beam area
  factor = 2 * pi * kepler_step * min(1.0,(2*thetamax/pi)) ! in au^2 
  factor = factor / kepler_dist**2    
  factor = factor * sec**2          ! Get it in Steradian
  factor = factor / beam_area       ! Divide by the beam area
  do istep = 1,nstep  
    !
    do kv = 1,nv
      if (n(kv,istep).ne.0 .and. m(kv).ne.0) then
        t(kv) = t(kv) + s(kv,istep) * factor * r(istep)
      else 
        t(kv) = bval
        m(kv) = 0
      endif
    enddo
  enddo  
  !
  ! OK got them. Extract the significant part...
  is = 0
  ie = ydim
  do kv=1,ydim
    v(kv) = (kv-yref)*yinc+yval
    if (is.eq.0) then
      if (t(kv).ne.bval) is = kv
    else if (ie.eq.ydim) then
      if (t(kv).eq.bval) then
        ie = kv-1
        exit
      endif
    endif
  enddo
  !
  ! Take the peak velocity
  if (do_peak) then
    iloc = maxloc(t)
    iv = iloc(1)
  else
    iv = nint((kepler_vdisk-yval)/yinc + yref)
  endif
  !
  ! Compute the rms noise
  call kepler_rms(t,ie,is,z)
  !
  kep_nrad = mstep
  kep_nchan = ie-is+1
  allocate(kep_spectrum(kep_nchan,3),kep_profile(kep_nrad,3), &
    & kep_spectra(kep_nchan,kep_nrad),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  kep_spectrum(:,1) = v(is:ie)
  kep_spectrum(:,2) = t(is:ie)
  kep_spectrum(:,3) = z
  !
  ! Get the radial profile from this channel - The problem
  ! is that we have no information on line width there...
  ! Let us get the brightness at line center, in K 
  !
  ! Line width can be derived from a model - They should be the same
  ! for all lines of the same object. - They can also be
  ! derived from a fit to the line profiles.
  !
  do istep=1,mstep
    call kepler_rms(s(:,istep),ie,is,z)
    kep_profile(istep,1) = r(istep)
    kep_profile(istep,2) = s(iv,istep)/jyperk
    kep_profile(istep,3) = z/jyperk
    where (s(is:ie,istep).ne.bval)
      kep_spectra(:,istep) = s(is:ie,istep)/jyperk 
    else where
      kep_spectra(:,istep) = bval
    end where
  enddo
  !
  error = .false.
  dim = [kep_nchan,3]
  call sic_def_dble('KEPLER_SPECTRUM',kep_spectrum,2,dim,.true.,error)
  dim = [kep_nrad,3]
  call sic_def_dble('KEPLER_PROFILE',kep_profile,2,dim,.true.,error)
  dim = [kep_nchan,kep_nrad]
  call sic_def_dble('KEPLER_SPECTRA',kep_spectra,2,dim,.true.,error)
  hvelo%loca%size = nx*ny
  hvelo%loca%addr = locwrd(hvelo%r2d)
  call gdf_get_extrema (hvelo,error)
  call sic_mapgildas('KEPLER_VELO',hvelo,error,hvelo%r2d)
  !
end subroutine kepler_compute
!
subroutine kepler_rms(t,ie,is,z)
  ! @ private
  real(4), intent(in) :: t(*)
  integer, intent(in) :: ie,is
  real(4), intent(out) :: z
  !
  integer k,kv
  real :: z1,z2
  !
  k = 0
  z1 = 0
  do kv=is,(3*is+ie)/4
    k = k+1
    z1 = z1+t(kv)**2
  enddo
  z1 = sqrt(z1/(k-1))
  k = 0
  z2 = 0
  do kv=(3*ie+is)/4,ie
    k = k+1
    z2 = z2+t(kv)**2
  enddo
  z2 = sqrt(z2/(k-1))
  !
  if (abs(z2-z1).lt.0.5*sqrt(z1*z2)) then
    z = sqrt(z1*z2)
  else
    Print *,'Warning, secondary peak... ',z1,sqrt(z1*z2),z2
    z = min(z1,z2)
  endif
end subroutine kepler_rms
!
subroutine kepler_init(error)
  use mod_kepler
  use gkernel_types
  use gkernel_interfaces
  logical, intent(out) :: error
  !
  integer(8) :: dim(1)
  !
  error = .false.
  !
  kepler_x0 = 0
  call sic_def_dble('KEPLER_X0',kepler_x0,0,dim,.false.,error) 
  if (error) return
  kepler_y0 = 0
  call sic_def_dble('KEPLER_Y0',kepler_y0,0,dim,.false.,error) 
  if (error) return
  kepler_rota = 0
  call sic_def_dble('KEPLER_ROTA',kepler_rota,0,dim,.false.,error) 
  if (error) return
  kepler_incli = 30.
  call sic_def_dble('KEPLER_INCLI',kepler_incli,0,dim,.false.,error) 
  if (error) return
  kepler_vmass = 3.
  call sic_def_dble('KEPLER_VMASS',kepler_vmass,0,dim,.false.,error) 
  if (error) return
  kepler_rint = 10.
  call sic_def_dble('KEPLER_RINT',kepler_rint,0,dim,.false.,error) 
  if (error) return
  kepler_rout = 500.
  call sic_def_dble('KEPLER_ROUT',kepler_rout,0,dim,.false.,error) 
  if (error) return
  kepler_dist = 150.
  call sic_def_dble('KEPLER_DIST',kepler_dist,0,dim,.false.,error) 
  if (error) return
  kepler_step = 50.
  call sic_def_dble('KEPLER_STEP',kepler_step,0,dim,.false.,error) 
  if (error) return
  kepler_theta = 60.
  call sic_def_dble('KEPLER_THETA',kepler_theta,0,dim,.false.,error) 
  if (error) return
  kepler_setup = .false.
end subroutine kepler_init
!


