program map_inter
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! GILDAS
  !	Compress OR Interpolate a data cube along its 3rd dimension
  !---------------------------------------------------------------------
  ! Local
  !
  character(len=filename_length) :: mapin, mapout
  integer :: n,new_size, ier
  integer(kind=index_length) :: ipix1,ipixn
  integer, allocatable :: ipi(:,:)
  real, allocatable :: ipr (:,:)
  real(8) :: new_val,new_ref,new_inc
  real :: pix1,pixn
  logical :: error
  type(gildas) :: x,y
  !
  call gildas_open
  call gildas_char('INPUT_MAP$',mapin)
  call gildas_char('OUTPUT_MAP$',mapout)
  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(mapin)
  if (n.eq.0) goto 100
  call gildas_null(y)
  y%gil%ndim = 3
  call gdf_read_gildas(y,mapin,'.lmv',error)
  if (error) then
     write(6,*) 'F-MAP_INTER,  Cannot read input file'
     goto 100
  endif
  !
  ! Create Output file
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  call sic_parsef(mapout,x%file,' ','.lmv')
  x%gil%blan_words = 2
  x%gil%dim(3) = new_size
  x%gil%inc(3) = new_inc
  x%gil%ref(3) = new_ref
  x%gil%val(3) = new_val
  !
  call gdf_create_image(x,error)
  if (error) then
     write(6,*) 'F-MAP_INTER,  Cannot create output image'
     goto 100
  endif
  !
  ! Check limits
  pix1 = x%gil%ref(3) + (y%gil%val(3) + (1-y%gil%ref(3))*y%gil%inc(3) - x%gil%val(3))/x%gil%inc(3)
  pixn = x%gil%ref(3) + (y%gil%val(3) + (y%gil%dim(3)-y%gil%ref(3))*y%gil%inc(3) - x%gil%val(3))/x%gil%inc(3)
  if (pix1.lt.pixn) then
     ipix1 = int(pix1)
     if (ipix1.ne.pix1) ipix1 = ipix1+1
     ipix1 = max(ipix1,1)
     ipixn = min(int(pixn),x%gil%dim(3))
  else
     ipixn = min(int(pix1),x%gil%dim(3))
     ipix1 = int(pixn)
     if (ipix1.ne.pixn) ipix1 = ipix1+1
     ipix1 = max(ipix1,1)
  endif
  !
  allocate (ipi(2,x%gil%dim(3)), ipr(4,x%gil%dim(3)), stat=ier)
  !
  allocate (x%r3d(x%gil%dim(1),x%gil%dim(2),x%gil%dim(3)) ,stat=ier)
  call all_inter(x%gil%dim(1)*x%gil%dim(2),ipix1,ipixn, x%r3d,x%gil%dim(3) &
       &,x%gil%inc(3),x%gil%ref(3),x%gil%val(3), y%r3d,y%gil%dim(3),y%gil%inc(3),y%gil%ref(3),y%gil%val(3),&
       & ipi, ipr) 
  !
  call gdf_write_data(x,x%r3d,error)  
  !
  call gagout('S-MAP_INTER,  Successful completion')
  call sysexi(1)
100 call sysexi(fatale)
!!end program map_inter
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                      !
  integer(kind=index_length) :: ic1                    !
  integer(kind=index_length) :: icn                    !
  integer(kind=index_length) :: xdim                   !
  real :: x(n,xdim)                 !
  real*8 :: xinc                    !
  real*8 :: xref                    !
  real*8 :: xval                    !
  integer(kind=index_length) :: ydim                   !
  real :: y(n,ydim)                 !
  real*8 :: yinc                    !
  real*8 :: yref                    !
  real*8 :: yval                    !
  integer :: iwork(2,xdim)          !
  real :: rwork(4,xdim)             !
  !	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 map_inter