program p_matchspectrum
  use gkernel_interfaces
  use image_def
  use gbl_message
  !$ use omp_lib
  !
  ! Compute Frequency Cross-Correlation spectrum
  ! of two UV tables
  !
  character(len=256) csmo,cuv,cspec 
  logical error
  type (gildas) :: hsmo,huv,hspec
  character(len=*), parameter :: rname='UV_MATCHSPECTRUM'
  integer :: iv, ic, ier
  !
  ! New
  real(kind=8) :: ininc, inref, inval
  real :: pix1,pixn,w
  integer(kind=index_length) :: ipix1,ipixn
  integer(kind=index_length) :: nchan
  real, allocatable :: ospec(:), ipr(:,:)
  integer, allocatable :: ipi(:,:)
  !
  call gildas_open
  call gildas_char('UVDATA$',cuv)
  call gildas_char('SMOOTH$',csmo)
  call gildas_char('SPECTRUM$',cspec)
  call gildas_close
  !
  call gildas_null(hsmo,type='UVT')
  call gildas_null(hspec) 
  call gildas_null(huv,type='UVT')
  !
  call sic_parse_file(cspec,' ','.tab',hspec%file)
  call sic_parse_file(cuv,' ','.uvt',huv%file)
  !
  call gdf_read_header(hspec,error)
  call gdf_read_header(huv,error)
  !
  nchan = huv%gil%nchan
  !
  call gdf_copy_header(huv,hsmo,error)
  call sic_parse_file(csmo,' ','.uvt',hsmo%file)
  !
  hsmo%gil%nchan = 1
  hsmo%gil%dim(1) = hsmo%gil%nlead + 3 + hsmo%gil%ntrail
  Print *,'Smooth size ',hsmo%gil%dim(1:2)
  call gdf_setuv(hsmo,error)
  !
  ! Shift trailing columns if needed
  if (hsmo%gil%ntrail.ne.0) then
    continue  ! To be done
  endif
  !
  ! Resample input spectrum onto the desired grid
  call gdf_allocate(hspec,error)
  call gdf_read_data(hspec,hspec%r2d,error)
  ! 1 Velocity, 2 Flux, ( 3 Frequency ) ?
  !
  ! Assume regularly spaced spectrum
  ininc = hspec%r2d(2,1)-hspec%r2d(1,1)
  inval = hspec%r2d(1,1)
  inref = 1.d0
  ! Check limits
  !!Print *,'INVAL ',inval,' end ',hspec%r2d(hspec%gil%dim(1),1), &
  !!  & (hspec%gil%dim(1)-inref)*ininc + inval, ' VOFF ',huv%gil%voff
  pix1 = huv%gil%ref(1) + ( inval + (1.d0-inref)  &
      & *ininc - huv%gil%voff ) / huv%gil%vres
  pixn = huv%gil%ref(1) + ( inval + (hspec%gil%dim(1)-inref)  &
      & *ininc - huv%gil%voff ) / huv%gil%vres
  !!Print *,'Pixels ',pix1,pixn
  if (pix1.lt.pixn) then
    ipix1 = int(pix1)
    if (ipix1.ne.pix1) ipix1 = ipix1+1
    ipix1 = max(ipix1,1)
    ipixn = min(int(pixn),nchan) 
  else
    ipixn = min(int(pix1),nchan)
    ipix1 = int(pixn)
    if (ipix1.ne.pixn) ipix1 = ipix1+1
    ipix1 = max(ipix1,1)
  endif
  !
  allocate (ipi(2,huv%gil%nchan), ipr(4,huv%gil%nchan), & 
    & ospec(huv%gil%nchan),stat=ier)
  !
  !!Print *,'Doing all_inter ',ipix1,ipixn,' nchan ',nchan,huv%gil%nchan
  call all_inter(1_8,ipix1,ipixn, &
    & ospec,nchan,dble(huv%gil%vres),huv%gil%ref(3),dble(huv%gil%val(3)), &
    & hspec%r2d(:,2),hspec%gil%dim(3),ininc,inref,inval, ipi, ipr)     
  !!Print *,'Done all_inter '
  !
  call gdf_close_image(hspec,error)
  !
  ! Will be done by Blocks later if needed
  call gdf_allocate(huv,error)
  call gdf_read_data(huv,huv%r2d,error)
  !!Print *,'Data read ',error
  call gdf_allocate(hsmo,error)
  !!Print *,'Smooth allocated ',error
  !  
  ! Normalize the spectrum to integral of 1
  w = sum(ospec)
  ospec = ospec/w
  !
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP &  SHARED(huv,hsmo,ospec,nchan) &
  !$OMP &  PRIVATE(iv,ic,w)
  !
  !$OMP DO
  do iv = 1, huv%gil%nvisi
    ! Sum each channel with the appropriate weight
    hsmo%r2d(1:7,iv) = huv%r2d(1:7,iv)
    !
    do ic = 1,nchan
      if (huv%r2d(7+3*ic,iv).gt.0) then
        hsmo%r2d(8,iv) = hsmo%r2d(8,iv) + huv%r2d(5+3*ic,iv) * ospec(ic)
        hsmo%r2d(9,iv) = hsmo%r2d(9,iv) + huv%r2d(6+3*ic,iv) * ospec(ic)
        hsmo%r2d(10,iv) = hsmo%r2d(10,iv) + huv%r2d(7+3*ic,iv) !! Need to figure out this later
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  call gdf_write_image(hsmo,hsmo%r2d,error)
  !
  contains
!
subroutine all_inter (n,ic1,icn,x,xdim,xinc,xref,xval,y,ydim,yinc,yref,yval,iwork,rwork)
  !---------------------------------------------------------------------
  ! LAS	Internal routine
  !	Performs the linear interpolation/integration
  ! Arguments:
  !	X	R*4(*)	Output spectrum
  !	N	I*4	Map size
  !	XDIM	I*4	Output pixel number
  !	XINC	R*8	Output first axis increment
  !	XREF	R*8	Output first axis reference pixel
  !	XVAL	R*8	Output first axis value at reference pixel
  ! 	Y	R*4(*)	Input spectrum
  !---------------------------------------------------------------------
  integer(kind=index_length) :: n       ! Map size, will be 1 here
  integer(kind=index_length) :: ic1     ! First output channel
  integer(kind=index_length) :: icn     ! Last output channel
  integer(kind=index_length) :: xdim    ! Output dimension
  real :: x(n,xdim)                     ! Output map
  real(8) :: xinc                    !
  real(8) :: xref                    !
  real(8) :: xval                    !
  integer(kind=index_length) :: ydim    ! Input dimension
  real :: y(n,ydim)                     ! Input map
  real(8) :: yinc                    !
  real(8) :: yref                    !
  real(8) :: yval                    !
  integer :: iwork(2,xdim)              ! Work array
  real :: rwork(4,xdim)                 ! Work array
  !	iwork = imin,imax
  !	rwork = rmin_1, rmin, rmax, rmax_1
  !
  integer i,imax,imin, j, k
  real(8) minpix, maxpix, pix, val, expand
  real rmin_1, rmin, rmax_1, rmax, smin, smax
  real scale
  !
  ! Special case: output axis = input axis
  if ((xdim.eq.ydim).and.(xref.eq.yref).and.(xval.eq.yval).and.(xinc.eq.yinc)) then
    x = y
    return
  endif
  !
  x = 0
  !
  expand = abs(xinc/yinc)
  scale  = 1.d0/expand
  do i = ic1, icn
    !
    ! Compute interval
    !
    val = xval + (i-xref)*xinc
    pix = (val-yval)/yinc + yref
    maxpix = pix + 0.5d0*expand
    minpix = pix - 0.5d0*expand
    imin = int(minpix+1.0d0)
    imax = int(maxpix)
    iwork(1,i) = imin
    iwork(2,i) = imax
    if (imax.ge.imin) then
      if (imin.gt.1) then
        !
        ! Lower end
        !
        ! YMIN = Y(IMIN-1)*(IMIN-MINPIX)+Y(IMIN)*(MINPIX-IMIN+1)
        !     and
        ! X(I) = X(I) + 0.5 * ( (IMIN-MINPIX)*(YMIN+Y(IMIN)) )
        !   
        ! Coefficient de IMIN-1: RMIN_1 = 0.5 * (IMIN-MINPIX)*(IMIN-MINPIX)
        ! Coefficient de IMIN:   RMIN   = 0.5 * (MINPIX-IMIN+2)*(IMIN-MINPIX)
        !
        smin = imin-minpix
        rwork(1,i) = 0.5*smin*smin
        rwork(2,i) = smin-rwork(1,i)
      else
        ! Coefficient de IMIN:      RMIN   = (IMIN-MINPIX)
        ! Coefficient de IMIN-1:    RMIN_1 = 0
        rwork(1,i) = 0.0
        rwork(2,i) = imin-minpix
      endif
      if (imax.lt.ydim) then
        ! Upper end
        smax = maxpix-imax
        rwork(4,i) = 0.5*smax*smax
        rwork(3,i) = smax-rwork(4,i)
      else
        rwork(3,i) = maxpix-imax
        rwork(4,i) = 0.0
      endif
      if (imax.eq.imin) then
        ! Point Case
        rwork(2,i) = rwork(2,i)+rwork(3,i)
        rwork(3,i) = 0.0
      else
        ! General Case: Add 1/2 of IMIN & IMAX + 1 of all intermediate
        ! channels
        rwork(2,i) = rwork(2,i)+0.5
        rwork(3,i) = rwork(3,i)+0.5
      endif
    else
      if (imin.gt.1) then
        rwork(1,i) = (imin-pix)
        rwork(2,i) = (pix+1-imin)
      else
        rwork(1,i) = 0.0
        rwork(2,i) = 1.0
      endif
    endif
  enddo
  !
  ! OK, now do it...
  do i = ic1, icn
    imin = iwork(1,i)
    imax = iwork(2,i)
    rmin_1 = rwork(1,i)
    rmin   = rwork(2,i)
    rmax   = rwork(3,i)
    rmax_1 = rwork(4,i)
    !
    if (imax.ge.imin) then
      ! General Trapezium integration
      if (imin.gt.1) then
        do j=1,n
          x(j,i) = y(j,imin-1)*rmin_1
        enddo
        do j=1,n
          x(j,i) = x(j,i) + y(j,imin)*rmin
        enddo
      else
        do j=1,n
          x(j,i) = y(j,imin)*rmin
        enddo
      endif
      if (imax.gt.imin) then
        do k = imin+1,imax-1
          do j=1,n
            x(j,i) = x(j,i) + y(j,k)
          enddo
        enddo
        do j=1,n
          x(j,i) = x(j,i) + y(j,imax)*rmax
        enddo
      endif
      if (imax.lt.ydim) then
        do j=1,n
          x(j,i) = x(j,i) + y(j,imax+1)*rmax_1
        enddo
      endif
      ! Normalise
      do j=1,n
        x(j,i) = x(j,i)*scale
      enddo
      !
    else
      ! Interpolation
      if (imin.gt.1) then
        do j=1,n
          x(j,i) = y(j,imin-1)*rmin_1
        enddo
        do j=1,n
          x(j,i) = x(j,i) + y(j,imin)*rmin
        enddo
      else
        do j=1,n
          x(j,i) = y(j,imin)
        enddo
      endif
    endif
  enddo
  !
end subroutine all_inter

end program p_matchspectrum

        
