program map_sum
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! GILDAS
  !	Compute an "integrated intensity" map
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: mapdata,mapsort
  integer(kind=4) :: nc(2), naver
  real(kind=4) :: velo(2),dv
  real(kind=8) :: xposi,yposi
  logical :: error
  type(gildas) :: x,y
  integer(kind=size_length) :: nd                 !
  integer(kind=4) :: ier
  !
  ! Code:
  call gildas_open
  call gildas_char('INPUT_MAP$',mapdata)
  call gildas_char('OUTPUT_MAP$',mapsort)
  call gildas_real('VELOCITY$',velo,2)
  call gildas_close
  !
  ! Input file
  call gildas_null(y)
  y%gil%form = fmt_r4
  y%gil%ndim = 3
  call gdf_read_gildas(y,mapdata,'.lmv',error, data=.false.) 
  if (error) then
    call gagout('F-MAP_COMPRESS,  Cannot read input data cube')
    goto 999
  endif
  !
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  call sic_parsef(mapsort,x%file,' ','.lmv')
  !
  ! Define number of channels
  nc(:) = nint((velo(:) - y%gil%val(3)) / y%gil%inc(3) + y%gil%ref(3))
  if (y%gil%inc(3).lt.0.0) then
    nc(1:2) = nc(2:1:-1)
  endif
  if (velo(1).eq.0) then
    nc(1) = 1
  else
    nc(1) = min(max(1,nc(1)),y%gil%dim(3))
  endif
  if (velo(2).eq.0) then
    nc(2) = y%gil%dim(3)
  else
    nc(2) = min(max(1,nc(2)),y%gil%dim(3))
  endif
  naver = nc(2)-nc(1)+1
  !
  ! Build a pseudo axis aligned on the input one:
  !  - Number of channels set to 1,
  !  - Increment set to the extracted range,
  !  - Value at reference unchanged (same spectroscopic axis, e.g. regarding
  !    associated Rest Freq),
  !  - Center of averaged range (old axis) is aligned on the center of the
  !    output channel #1 (new axis)
  ! This writes as:
  x%gil%dim(3) = 1
! x%gil%val(3) = unchanged
  yposi = (nc(1)+nc(2))*0.5d0
  xposi = 1.d0
  x%gil%inc(3) = y%gil%inc(3)*naver
  x%gil%ref(3) = xposi - (yposi-y%gil%ref(3))/naver
  ! Do not forget the SPECTRO section
  x%gil%vres = y%gil%vres*naver
  x%gil%fres = y%gil%fres*naver
! x%gil%voff = unchanged
! x%gil%freq = unchanged
! x%gil%fima = unchanged
  !
  x%loca%size = x%gil%dim(1)*x%gil%dim(2)
  if (y%char%code(3).eq.'VELOCITY') then
    x%char%unit = trim(y%char%unit)//'.km/s'
  elseif (y%char%code(3).eq.'FREQUENCY') then
    x%char%unit = trim(y%char%unit)//'.MHz'
  else
    x%char%unit = 'UNKNOWN'
  endif
  x%gil%extr_words = 0
  call gdf_create_image(x,error)
  if (error) goto 999
  !
  allocate(x%r2d(x%gil%dim(1),x%gil%dim(2)),  &
           y%r3d(x%gil%dim(1),y%gil%dim(2),nc(2)-nc(1)+1),  &
           stat=ier)
  if (ier.ne.0) goto 999
  !
  y%blc(3) = nc(1)
  y%trc(3) = nc(2)
  call gdf_read_data(y,y%r3d,error)
  if (error) goto 999
  !
  dv = abs(y%gil%inc(3))
  nd = x%gil%dim(1)*x%gil%dim(2)
  call compress (y%r3d,nd,x%r2d,naver,dv,y%gil%bval,y%gil%eval)
  call gdf_write_data(x,x%r2d,error)
  if (error) goto 999
  call gagout('S-MAP_SUM,  Successful completion')
  call sysexi(1)
999 call sysexi(fatale)
end program map_sum
!
subroutine compress (in,n,out,nc,dv,bval,eval)
  use gildas_def
  integer(kind=size_length), intent(in)  :: n         ! Number of pixels
  integer(kind=4),           intent(in)  :: nc        ! Number of channels
  real(kind=4),              intent(in)  :: in(n,nc)  ! Input cube
  real(kind=4),              intent(out) :: out(n)    ! Output map
  real(kind=4),              intent(in)  :: dv        ! Channel width
  real(kind=4),              intent(in)  :: bval,eval ! Blanking
  ! Local
  integer(kind=size_length) :: ii
  integer(kind=4) :: ic
  integer(kind=1) :: mask(n)  ! Automatic array
  !
  if (eval.lt.0.) then
    out(:) = in(:,1)
    do ic=2,nc
      out(:) = out(:) + in(:,ic)
    enddo
    out(:) = out(:)*dv
  else
    out(:) = 0.
    mask(:) = 1
    do ic=1,nc
      do ii=1,n
        if (abs(in(ii,ic)-bval).gt.eval) then
          out(ii) = out(ii) + in(ii,ic)
          mask(ii) = 0
        endif
      enddo
    enddo
    out(:) = out(:)*dv
    where (mask.eq.1)
      out = bval
    endwhere
  endif
  !
end subroutine compress
