subroutine moments_comm(line,error)
  use gkernel_interfaces
  use clean_arrays
  use gbl_message
  !---------------------------------------------------------------------
  ! IMAGER
  !   Support for command
  !       MOMENT [Area Peak Velocity Width] 
  !         [/METHOD Mean Peak Parabolic]
  !         [/RANGE Min Max TYPE] [/THRESHOLD Min]
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MOMENTS'
  !
  call sic_delvariable ('M_AREA',.false.,error)
  call sic_delvariable ('M_PEAK',.false.,error)
  call sic_delvariable ('M_VELO',.false.,error)
  call sic_delvariable ('M_WIDTH',.false.,error)
  error = .false.
  !
  if (hsky%loca%size.ne.0) then
    call map_message(seve%i,rname,'Using SKY cube')
    hsky%r3d => dsky
    call sub_moments(hsky,line,error)
  else if (hclean%loca%size.ne.0) then
    call map_message(seve%i,rname,'Using CLEAN cube')
    hclean%r3d => dclean
    call sub_moments(hclean,line,error)
  else
    call map_message(seve%e,rname,'No CLEAN or SKY brightness cube')
    error = .true.
  endif
end subroutine moments_comm
!
subroutine sub_moments(horigin,line,error)
  use gkernel_interfaces
  use clean_arrays
  use moment_arrays
  use gbl_message
  use imager_interfaces
  !---------------------------------------------------------------------
  ! IMAGER
  !   Support for command
  !       MOMENT [Area Peak Velocity Width] 
  !         [/METHOD Mean Peak Parabolic]
  !         [/RANGE Min Max TYPE] [/THRESHOLD Min]
  !
  !	A dedicated routine to compute the moment of an input data cube.
  !	Input: a LMV cube
  !	Output: any or all of 4 images
  !           1) the integrated intensity map
  !           2) the Peak brightness
  !           3) The mean velocity
  !           4) The line width
  !	Method:
  !     AREA      Integrated intensity in Velocity range
  !
  !     PEAK      Peak intensity in Velocity range
  !     VELOCITY  Velocity of peak  
  !     WIDTH     2nd moment: line width, using the Velocity
  !               assigned 
  ! The peak intensity is obtained either as a per-channel basis,
  ! or a parabolic fit around the maximum. The Velocity is obtained
  ! in a similar way, or intensity weighted.
  !     
  !       For each spectrum, make a gate in velocity and clip based on
  !       intensity. Sum up weighted velocity and mean intensity.
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: horigin ! Input image, CLEAN or SKY
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  character(len=*), parameter :: rname='MOMENTS'
  real(8), parameter :: pi=3.14159265358979323846d0
  ! Local
  integer, parameter :: o_mask=1
  integer, parameter :: o_method=2
  integer, parameter :: o_range=3
  integer, parameter :: o_seuil=4
  !
  character(len=12) :: cmeth,ch,new_unit
  integer :: nc(2)
  real(8) :: drange(2), freq, href
  character(len=12) :: csort
  integer(kind=4) :: isort
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort),mysort
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !  
  character(len=80) :: chain
  real(kind=4) :: seuil,dv,vfirst,vlast
  integer(kind=4) :: ier,n
  integer(kind=index_length) :: nv,nx,ny,i,j,iplane
  integer(kind=size_length) :: nxy
  real(kind=4), allocatable :: ipb(:)
  real(kind=4), pointer :: odata(:,:,:)
  real :: lambda, jyperk, sigma
  logical :: do_mask
  type(gildas) :: hin
  !
  if (allocated(dmean)) then
    deallocate(dmean,dpeak,dvelo,dwidth,stat=ier)
  endif
  !
  do_mask = sic_present(o_mask,0)
  if (do_mask) then
    if (.not.allocated(dmask)) then
      call map_message(seve%e,rname,'No mask allocated for the /MASK option')
      error = .true.
    else if (hin%gil%dim(1).ne.hmask%gil%dim(1) .or. &
      & hin%gil%dim(2).ne.hmask%gil%dim(2)) then
      call map_message(seve%e,rname,'MASK and image do not match')
      error = .true.
    endif
    if (error) return
  endif    
  !
  ! Compute the channel range
  if (sic_present(o_range,0)) then
    ! /RANGE (for flexibility)
    call sic_r8 (line,o_range,1,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,o_range,2,drange(2),.true.,error)
    if (error) return
    call sic_ke (line,o_range,3,csort,n,.true.,error)
    if (error) return
    error = .false.
    call sic_ambigs(rname//' /RANGE',csort,mysort,isort,types,msort,error)
    if (error)  return
  else
    ! Default is FIRST and LAST channels
    mysort = 'CHANNEL'
    drange = 0.d0
    call sic_get_dble('FIRST',drange(1),error)
    call sic_get_dble('LAST',drange(2),error)
  endif
  call out_range(rname,mysort,drange,nc,horigin,error)
  if (error) return
  !
  ! Get the threshold. Default is 3 sigma
  sigma = max(horigin%gil%noise,horigin%gil%rms)
  if (sic_present(o_seuil,0)) then
    call sic_r4(line,o_seuil,1,seuil,.false.,error)
    if (error) return
    ch = 'SIGMA'
    call sic_ke(line,o_seuil,2,ch,n,.false.,error)
    if (ch.eq.'SIGMA') then
      if (sigma.ne.0) then
        seuil = seuil*sigma
      else
        call map_message(seve%e,rname,'Noise statistic not available, specify /THRESHOLD value FLUX')
        error = .true.
        return
      endif
    else if (ch.ne.'FLUX') then
      call map_message(seve%e,rname,'Invalid threshold unit '//ch)
      error = .true.
      return
    endif
  else
    if (sigma.ne.0) then
      seuil = 3*sigma
    else
      call map_message(seve%e,rname,'Noise statistic not available, specify /THRESHOLD value FLUX')
      error = .true.
      return
    endif
  endif
  !
  ! Change to Velocity representation
  call gildas_null(hin)
  call gdf_copy_header(horigin,hin,error)
  new_unit = 'VELOCITY'
  call gdf_modify(hin,hin%gil%voff,hin%gil%freq,new_unit,error)
  if (error) return
  !
  ! Get the method
  cmeth = 'MEAN'
  call sic_ke(line,o_method,1,cmeth,n,.false.,error)
  if (error) return
  select case (cmeth)
  case ('MEAN','PEAK','PARABOLA') 
    call map_message(seve%i,rname,'Using method '//cmeth)
  case default
    call map_message(seve%e,rname,'Invalid method '//cmeth)
    error = .true.
    return
  end select
  !
  nx = hin%gil%dim(1)
  ny = hin%gil%dim(2)
  nv = hin%gil%dim(3)
  !
  !
  ! Modify the requested part of the PEAK Header
  call gildas_null(hpeak)
  call gdf_copy_header(hin,hpeak,error)
  hpeak%gil%dim(3) = 1
  hpeak%char%code(3) = 'UNKNOWN'
  hpeak%gil%convert(:,3) = 1.d0
  hpeak%gil%extr_words = def_extr_words
  hpeak%gil%blan_words = 2
  ! Convert to Brightness ??
  ! hpeak%char%unit = 'K' ! and JyperK factor 
  hpeak%gil%faxi = 0
  hpeak%gil%bval = 0
  hpeak%gil%eval = 0
  hpeak%loca%size = nx*ny
  !
  ! Modify the requested part of the MEAN Header
  call gildas_null(hmean)
  call gdf_copy_header(hpeak,hmean,error)
  if (hin%char%code(3).eq.'VELOCITY') then
    hmean%char%unit = trim(hin%char%unit)//'.km/s'
  elseif (hin%char%code(3).eq.'FREQUENCY') then
    hmean%char%unit = trim(hin%char%unit)//'.MHz'
  else
    hmean%char%unit = 'UNKNOWN'
  endif
  !
  ! As above for VELOCITY image
  call gildas_null(hvelo)
  call gdf_copy_header(hpeak,hvelo,error)
  if (hin%char%code(3).eq.'VELOCITY') then
    hvelo%char%unit = 'km/s'
  elseif (hin%char%code(3).eq.'FREQUENCY') then
    hvelo%char%unit = 'MHz'
  else
    hvelo%char%unit = 'UNKNOWN'
  endif
  !
  ! As above for line width
  call gildas_null(hwidth)
  call gdf_copy_header(hvelo,hwidth,error)
  !
  ! Do some useful job
  nxy = hmean%gil%dim(1)*hmean%gil%dim(2)
  allocate (dmean(nx,ny), dvelo(nx,ny), dpeak(nx,ny),  &
            dwidth(nx,ny), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  dmean = 0.
  dvelo = 0.
  dwidth = 0.
  dpeak = 0.
  !
  dv = abs(hin%gil%inc(3))
  !
  ! Loop in valid range
  write(chain,*) 'Channel range ',nc(1),nc(2)
  call map_message(seve%i,rname,chain)
  if (hin%gil%inc(3).gt.0) then
    vfirst = (nc(1)-0.5-hin%gil%ref(3))*hin%gil%inc(3)+hin%gil%val(3)
    vlast  = (nc(2)+0.5-hin%gil%ref(3))*hin%gil%inc(3)+hin%gil%val(3)
  else
    vlast = (nc(2)-0.5-hin%gil%ref(3))*hin%gil%inc(3)+hin%gil%val(3)
    vfirst  = (nc(1)+0.5-hin%gil%ref(3))*hin%gil%inc(3)+hin%gil%val(3)
  endif
  write(chain,*) 'Velocity range ',vfirst,vlast
  call map_message(seve%i,rname,chain)
  !
  ! Only copy when needed
  if (do_mask) then
    ! And only copy what is needed
    nv = nc(2)-nc(1)+1
    allocate(odata(nx,ny,nv), stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    do i=nc(1),nc(2)
      j = i-nc(1)+1
      ! Find out the mask plane
      freq = (i-hin%gil%ref(3))*hin%gil%fres + hin%gil%freq
      iplane = nint((freq-hmask%gil%freq)/hmask%gil%fres + hmask%gil%ref(3))
      iplane = min(max(1,iplane),hmask%gil%dim(3)) ! Just  in case
      odata(:,:,j) = horigin%r3d(:,:,i) 
      where (dmask(:,:,iplane).eq.0) odata(:,:,j) = 0.
    enddo
    nc(1) = 1
    nc(2) = nv
    href = hin%gil%ref(3)-nc(1)+1   ! Shift reference pixel
  else
    odata => horigin%r3d
    href = hin%gil%ref(3)
  endif
  !
  ! Set the velocity scale
  allocate(ipb(nv),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif 
  call set_velo(nv,ipb,href,hin%gil%val(3),hin%gil%inc(3))
  !
  ! Compute the moments
  call compute_moments(cmeth,odata,nx*ny,nv,dmean,dvelo, &
    & dwidth,dpeak, ipb,nc(1),nc(2), seuil, &
    & hin%gil%bval,hin%gil%eval)
  ! Scale intensity map
  dmean = dmean * dv
  ! Scale line width to equivalent Gaussian profile
  dv = sqrt(8.0*alog(2.0))
  dwidth = dwidth * dv
  !
  ! Scale the Peak brightness to Kelvin
  lambda = 2.99792458e8/hpeak%gil%freq*1e-6
  jyperk = 2.0*1.38e3*   &
   &      pi*hpeak%gil%majo*hpeak%gil%mino/4./log(2.0)   &
   &      /lambda**2.
  dpeak = dpeak/jyperk
  hpeak%char%unit = 'K'
  hpeak%gil%noise = hpeak%gil%noise/jyperk
  hpeak%gil%rms = hpeak%gil%rms/jyperk
  !
  ! Define the SIC variables
  hmean%loca%addr = locwrd(dmean)
  call gdf_get_extrema (hmean,error)
  hpeak%loca%addr = locwrd(dpeak)
  call gdf_get_extrema (hpeak,error)
  hvelo%loca%addr = locwrd(dvelo)
  call gdf_get_extrema (hvelo,error)
  hwidth%loca%addr = locwrd(dwidth)
  call gdf_get_extrema (hwidth,error)
  call sic_mapgildas ('M_AREA',hmean,error,dmean)
  call sic_mapgildas ('M_PEAK',hpeak,error,dpeak)
  call sic_mapgildas ('M_VELO',hvelo,error,dvelo)
  call sic_mapgildas ('M_WIDTH',hwidth,error,dwidth)
  !
  ! return  with some acknowledgement message
  call message_colour(2)
  call map_message(seve%i,rname,'Successful completion')
  call message_colour(-1)
  if (do_mask) deallocate(odata)
end subroutine sub_moments
!
subroutine compute_moments(method,a,nxy,nv,a0,a1,a2,a3,v, &
  & ivmin,ivmax,s,bval,eval)
  use gildas_def
  character(len=*), intent(in) :: method
  integer(kind=size_length),  intent(in)  :: nxy
  integer(kind=index_length), intent(in)  :: nv
  real(kind=4),               intent(in)  :: a(nxy,nv)
  real(kind=4),               intent(out) :: a0(nxy)  ! 0th moment
  real(kind=4),               intent(out) :: a1(nxy)  ! 1st moment
  real(kind=4),               intent(out) :: a2(nxy)  ! 2nd moment
  real(kind=4),               intent(out) :: a3(nxy)  ! Peak value
  real(kind=4),               intent(in)  :: v(nv)    ! Velocities
  integer(kind=4), intent(in)  :: ivmin
  integer(kind=4), intent(in)  :: ivmax
  real(kind=4),               intent(in)  :: s
  real(kind=4),               intent(in)  :: bval,eval
  ! Local
  integer(kind=size_length) :: i
  integer(kind=index_length) :: k
  integer :: kloc(1)
  real(kind=4) :: a12, aa, bb, cc
  real, allocatable :: spectrum(:)
  integer :: ier, jvmin, jvmax
  !
  if (method.eq.'MEAN') then
    if (eval.lt.0.) then
      do k=ivmin,ivmax
        do i=1,nxy
          if (a(i,k).ge.s) then
            a0(i) = a0(i) + a(i,k)
            a1(i) = a1(i) + v(k)*a(i,k)
            a2(i) = a2(i) + v(k)*v(k)*a(i,k)
            a3(i) = max(a3(i),a(i,k))
          endif
        enddo
      enddo
    else
      do k=ivmin,ivmax
        do i=1,nxy
          if (a(i,k).ge.s .and. abs(a(i,k)-bval).gt.eval) then
            a0(i) = a0(i) + a(i,k)
            a1(i) = a1(i) + v(k)*a(i,k)
            a2(i) = a2(i) + v(k)*v(k)*a(i,k)
            a3(i) = max(a3(i),a(i,k))
          endif
        enddo
      enddo
    endif
    !
    do i=1,nxy
      if (a0(i).ne.0.0) then
        a1(i) = a1(i)/a0(i)
        a2(i) = a2(i)/a0(i)
        a12 = a1(i)*a1(i)
        if (a12.gt.a2(i)) then
          a2(i) = 0.0
        else
          a2(i) = sqrt(a2(i) - a12)
        endif
      else
        a1(i) = 0.0
        a2(i) = 0.0
      endif
    enddo
  else if (method.eq.'PEAK') then
    if (eval.lt.0.) then
      do k=ivmin,ivmax
        do i=1,nxy
          if (a(i,k).ge.s) then
            a0(i) = a0(i) + a(i,k)
            a3(i) = max(a3(i),a(i,k))
            if (a3(i).eq.a(i,k)) a1(i) = v(k)
          endif
        enddo
      enddo
      !
      ! Second pass for Width
      do k=ivmin,ivmax
        do i=1,nxy
          if (a(i,k).ge.s) then
            a2(i) = a2(i) + (v(k)-a1(i))**2 * a(i,k)
          endif
        enddo
      enddo      
    else
      do k=ivmin,ivmax
        do i=1,nxy
          if (a(i,k).ge.s .and. abs(a(i,k)-bval).gt.eval) then
            a0(i) = a0(i) + a(i,k)
            a3(i) = max(a3(i),a(i,k))
            if (a3(i).eq.a(i,k)) a1(i) = v(k)
          endif
        enddo
      enddo
      do k=ivmin,ivmax
        do i=1,nxy
          if (a(i,k).ge.s .and. abs(a(i,k)-bval).gt.eval) then
            a2(i) = a2(i) + (v(k)-a1(i))**2 * a(i,k)
          endif
        enddo
      enddo
    endif
    !
    do i=1,nxy
      if (a0(i).ne.0.0) then
        a2(i) = sqrt(a2(i)/a0(i))
      else
        a1(i) = 0.0
        a2(i) = 0.0
      endif
    enddo
  else if (method.eq.'PARABOLA') then
    !
    ! Do it in non-optimal memory order
    allocate (spectrum(nv),stat=ier)
    jvmin = max(2,ivmin)
    jvmax = min(nv-1,ivmax)
    !
    if (eval.lt.0.) then
      do i=1,nxy
        spectrum(:) = a(i,1:nv) 
        kloc = maxloc(spectrum(jvmin:jvmax)) 
        k = kloc(1) + jvmin-1
        ! aa*v2 + bb*v + cc
        call parabola_3pt(v(k-1:k+1),spectrum(k-1:k+1),aa,bb,cc) 
        a1(i) = -bb/(2*aa)
        if (a1(i).lt.v(1) .or. a1(i).gt.v(nv) ) then
          a1(i) = v(k)
          a3(i) = spectrum(k)
        else
          a3(i) = (aa*a1(i) + bb)*a1(i) + cc
        endif
        do k=jvmin,jvmax
          if (spectrum(k).ge.s) then
            a0(i) = a0(i) + spectrum(k)
            a2(i) = a2(i) + (v(k)-a1(i))**2 * spectrum(k)
          endif
        enddo
      enddo
    else
      do i=1,nxy
        spectrum(:) = a(i,1:nv) 
        where (abs(spectrum-bval).le.eval) spectrum = 0
        !
        kloc = maxloc(spectrum(jvmin:jvmax)) 
        k = kloc(1) + jvmin-1
        ! aa*v2 + bb*v + cc
        call parabola_3pt(v(k-1:k+1),spectrum(k-1:k+1),aa,bb,cc) 
        a1(i) = -bb/(2*aa)
        if (a1(i).lt.v(1) .or. a1(i).gt.v(nv) ) then
          a1(i) = v(k)
          a3(i) = spectrum(k)
        else
          a3(i) = (aa*a1(i) + bb)*a1(i) + cc
        endif
        do k=jvmin,jvmax
          if (spectrum(k).ge.s) then
            a0(i) = a0(i) + spectrum(k)
            a2(i) = a2(i) + (v(k)-a1(i))**2 * spectrum(k)
          endif
        enddo
      enddo
    endif
    !
    ! Normalize
    do i=1,nxy
      if (a0(i).ne.0.0) then
        a2(i) = sqrt(a2(i)/a0(i))
      else
        a1(i) = 0.0
        a2(i) = 0.0
        a3(i) = 0.0
      endif
    enddo
  endif
end subroutine compute_moments
!
subroutine set_velo(nv,av,ref,val,inc)
  use gildas_def
  integer(kind=index_length), intent(in)  :: nv
  real(kind=4),               intent(out) :: av(nv)
  real(kind=8),               intent(in)  :: ref,val,inc
  ! Local
  integer(kind=index_length) :: iv
  do iv=1,nv
    av(iv) = (iv-ref)*inc+val
  enddo
end subroutine set_velo
!
subroutine parabola_3pt(x,y,aa,bb,cc) 
  !----------------------------------------------------------------------
  !	Solve for Y = aa*x^2 + bb*x + cc with 3 points input data
  !----------------------------------------------------------------------
  real, intent(in) :: x(3)
  real, intent(in) :: y(3)
  real, intent(out) :: cc,bb,aa
  !
  aa = (y(3)-y(2))*(x(2)-x(1))-(y(2)-y(1))*(x(3)-x(2))
  bb = (x(2)-x(1))*(x(3)*x(3)-x(2)*x(2))-(x(2)*x(2)-x(1)*x(1))*(x(3)-x(2))
  aa = aa/bb
  bb = (y(2)-y(1))-aa*(x(2)*x(2)-x(1)*x(1))
  bb = bb/(x(2)-x(1))
  cc = y(1)-aa*x(1)*x(1)-bb*x(1)
end subroutine parabola_3pt
