program interpol
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! GILDAS
  !	Interpolate (linearly) first axis of a cube onto another grid
  ! T.Forveille 30-June-1986
  !---------------------------------------------------------------------
  ! Local
  real, parameter :: eps=1.e-7
  !
  character(len=filename_length) :: namex,namey
  integer :: n, j,k,l,ier,new_size
  real(8) :: new_val,new_ref,new_inc
  real :: pix1,pixn
  logical :: error
  type(gildas) :: x,y
  !
  call gildas_open
  call gildas_char('Y_NAME$',namey)
  call gildas_char('X_NAME$',namex)
  call gildas_inte('NX$',new_size,1)
  call gildas_dble('REFERENCE$',new_ref,1)
  call gildas_dble('VALUE$',new_val,1)
  call gildas_dble('INCREMENT$',new_inc,1)
  call gildas_close
  !
  n = len_trim(namey)
  if (n.eq.0) goto 100
  call gildas_null(y)
  call gdf_read_gildas(y,namey,'.gdf',error, data=.false.)
  !
  ! Create Output file
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  n = len_trim(namex)
  if (n.eq.0) goto 100
  call sic_parsef(namex(1:n),x%file,' ','.gdf')
  x%gil%blan_words = 2
  !
  x%gil%dim(1) = new_size
  x%gil%inc(1) = new_inc
  x%gil%ref(1) = new_ref
  x%gil%val(1) = new_val
  !
  ! Adapt also x%gil%fres and x%gil%vres if needed.
  if (x%char%code(1).eq.'VELOCITY') then
    x%gil%vres=x%gil%inc(1)
    x%gil%voff=x%gil%val(1)
    x%gil%fres=-x%gil%inc(1)*x%gil%freq/299792.458d0
  endif
  !
  ! Check limits
  pix1 = y%gil%ref(1) + (x%gil%val(1) +   &
     &    (1.d0-x%gil%ref(1))*x%gil%inc(1) - y%gil%val(1))/y%gil%inc(1)
  pixn = y%gil%ref(1) + (x%gil%val(1) +   &
     &    (x%gil%dim(1)-x%gil%ref(1))*x%gil%inc(1) - y%gil%val(1))/y%gil%inc(1)
  if ( (pix1+eps).lt.1. .or. (pix1-eps).gt.y%gil%dim(1) .or.   &
     &    (pixn+eps).lt.1. .or. (pixn-eps).gt.y%gil%dim(1) ) then
    write(6,*) 'F-INTERPOLATE,  Extrapolation is forbidden'
    goto 100
  endif
  !
  call gdf_create_image(x,error)
  !
  if (error) then
    write(6,*) 'F-INTERPOLATE,  Cannot create output image'
    goto 100
  endif
  !
  allocate(x%r2d(x%gil%dim(1),x%gil%dim(2)), y%r2d(y%gil%dim(1),y%gil%dim(2)), stat=ier)
  !
  do l=1,x%gil%dim(4)
    x%blc(4) = l
    x%trc(4) = l
    do k=1,x%gil%dim(3)
      x%blc(3) = k
      x%trc(3) = k
      y%blc = x%blc
      y%trc = x%trc
      call gdf_read_data(y,y%r2d,error)
      do j=1,x%gil%dim(2)
        call interpolate(   &
     &          x%r2d(:,j),x%gil%dim(1),x%gil%inc(1),x%gil%ref(1),x%gil%val(1),   &
     &          y%r2d(:,j),y%gil%dim(1),y%gil%inc(1),y%gil%ref(1),y%gil%val(1))
      enddo
      call gdf_write_data(x,x%r2d,error)
    enddo
  enddo
  !
  call gagout('S-INTERPOLATE,  Successful completion')
  call sysexi (1)
  !
100 call sysexi (fatale)
end program interpol
!
subroutine interpolate(x,xdim,xinc,xref,xval,   &
     &    y,ydim,yinc,yref,yval)
  use gildas_def
  !---------------------------------------------------------------------
  ! LAS	Internal routine
  !	Performs the linear interpolation/integration
  ! Arguments:
  !	X	R*4(*)	Output spectrum
  !	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
  !  15-nov-1990 Correction R.L.
  !   (ne marchait pas dans le cas de l'interpolation ..)
  !---------------------------------------------------------------------
  integer(kind=index_length) :: xdim                   !
  real :: x(xdim)                   !
  real(8) :: xinc                    !
  real(8) :: xref                    !
  real(8) :: xval                    !
  integer(kind=index_length) :: ydim                   !
  real :: y(ydim)                   !
  real(8) :: yinc                    !
  real(8) :: yref                    !
  real(8) :: yval                    !
  ! Local
  integer :: i,imax,imin, j
  real(8) :: minpix, maxpix, pix, val, expand, ymax, ymin
  real :: scale
  !
  expand = abs(xinc/yinc)
  scale  = 1.0d0/(2.0d0*expand)
  do i = 1, xdim
    !
    ! 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)
    if (imax.ge.imin) then
      ymin = y(imin-1)*(imin-minpix)+y(imin)*(minpix-imin+1)
      x(i) = (imin-minpix)*(ymin+y(imin))
      if (imax.gt.imin) then
        do j=imin, imax-1
          x(i) = x(i) + y(j)+y(j+1)
        enddo
      endif
      ymax = y(imax+1)*(maxpix-imax)+y(imax)*(imax+1-maxpix)
      x(i) = x(i) + (maxpix-imax)*(ymax+y(imax))
      x(i) = x(i)*scale
    else
      x(i) = y(imin-1)*(imin-pix) + y(imin)*(pix-imin+1)
    endif
  enddo
end subroutine interpolate
