subroutine combine_comm(line,error)
  !! IMAGER -- Dispatch routine for COMBINE
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  call map_combine_sub(line,error,.true.)
end subroutine combine_comm
! 
subroutine map_combine_comm(line,error)
  !! IMAGER -- Dispatch routine for MAP_COMBINE
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  call map_combine_sub(line,error,.false.)
end subroutine map_combine_comm
!
subroutine map_combine_sub(line,error,resample)
  use image_def
  use gkernel_interfaces
  use imager_interfaces, only : do_combine, map_message
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for commands COMBINE and MAP_COMBINE
  !
  ! MAP_COMBINE Out CODE In1 In2 /factor A1 A2 /THRESHOLD T1 T2 /BLANKING Bval  
  !   or  
  ! COMBINE Out CODE In1 In2 /factor A1 A2 /THRESHOLD T1 T2 /BLANKING Bval
  !
  !     Combine in different ways two input images (or data cubes)...
  !
  !     Out can be a file name or an existing Image variable.   
  !         The distinction is made by the existence of a "." in the name
  !         If it is a file, it is created like the In1 Variable
  !         If it is an Image variable, it must match the shape of 
  !           the In1 Variable
  !     In1 can be a file name or an existing Image variable.  
  !     In2 can be a file name or an existing Image variable.  
  !         The rank of In2 must be smaller than that of In1, and
  !         other dimensions must match          
  !!
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: line    !! Input command line
  logical, intent(out) :: error           !! Return error flag
  logical, intent(in) :: resample         !! Allow automatic Resampling
  !
  ! Constants 
  integer, parameter :: o_blank=1, o_factor=2, o_thre=3, o_rela=4
  character(len=*), parameter :: rname='MAP_COMBINE'
  integer, parameter :: mcode=10
  character(len=14) :: scode(mcode)
  data scode/'ADD','DIVIDE','MULTIPLY','OPTICAL_DEPTH','INDEX','SUBTRACT','PLUS','MINUS','OVER','TIMES'/ 
  ! Local ---
  character(len=filename_length) :: namex,namey,namez
  character(len=20) :: code, argum
  real :: ay,az,ty,tz,b,c
  logical :: do_blank, relative
  integer :: n, ier
  !
  ! Code ----
  call sic_ch(line,0,1,namex,n,.true.,error)
  if (error) return
  call sic_ch(line,0,2,argum,n,.true.,error)
  if (error) return
  az = 1.
  ay = 1.
  if (argum.eq.'=') then
    if (sic_present(o_factor,0)) then
      call map_message(seve%e,rname,'Option /FACTOR is incompatible with free syntax')
      error = .true.
      return
    endif
    ! COMBINE  Out = F*In1 Oper G*In2
    !
    call sic_ke(line,0,4,argum,n,.true.,error)
    if (error) return
    select case (argum)
    case ('+') 
      code = 'ADD'
    case ('-')
      code = 'SUBTRACT'
    case ('*') 
      code = 'MULTIPLY'
    case ('|')
      code = 'DIVIDE'
    case default    
      call sic_ambigs (rname,argum,code,n,scode,mcode,error)
    end select
    if (error) return
    !
    call sic_ch(line,0,3,namey,n,.true.,error)
    if (error) return
    n = index(namey,'*')
    if (n.ne.0) then
      read(namey(1:n-1),*,iostat=ier) ay
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Invalid 1st factor '//namey(1:n))
        error = .true.
        return
      endif
      namey = namey(n+1:)
    endif
    !
    call sic_ch(line,0,5,namez,n,.true.,error)
    if (error) return
    n = index(namez,'*')
    if (n.ne.0) then
      read(namez(1:n-1),*,iostat=ier) az
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Invalid 2nd factor '//namez(1:n))
        error = .true.
        return
      endif
      namez = namez(n+1:)
    endif
    !
    c = 0
    call sic_r4(line,0,6,c,.false.,error)
    !
  else
    call sic_ch(line,0,2,argum,n,.true.,error)
    if (error) return
    call sic_ambigs (rname,argum,code,n,scode,mcode,error)
    if (error) return
    call sic_ch(line,0,3,namey,n,.true.,error)
    if (error) return
    call sic_ch(line,0,4,namez,n,.true.,error)
    if (error) return
    c = 0
    call sic_r4(line,0,5,c,.false.,error)
    if (error) return
    call sic_r4(line,o_factor,2,az,.false.,error)
    call sic_r4(line,o_factor,1,ay,.false.,error)
  endif
  !
  tz = -huge(1.0)
  ty = tz
  !
  call sic_r4(line,o_thre,2,tz,.false.,error)
  call sic_r4(line,o_thre,1,ty,.false.,error)
  !
  if ((code.eq.'SUBTRACT').or.(code.eq.'MINUS')) then
    code = 'ADD'
    az = -az
  endif
  !
  if (sic_present(o_blank,0)) then
    call sic_r4(line,o_blank,1,b,.true.,error)
    do_blank = .true.
  else
    do_blank = .false.
  endif
  !
  relative = sic_present(o_rela,0)
  !
  call do_combine(namex,namey,namez,code,c,ay,ty,az,tz,error, &
    & resample,b,do_blank,relative)
end subroutine map_combine_sub
!
subroutine do_combine(namex,namey,namez,code,c,ay,ty,az,tz,error, &
  & resample, b, do_blank, relative)
  use imager_interfaces, except_this => do_combine
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use iso_c_binding
  !----------------------------------------------------------------------
  ! @ private-mandatory
  !*
  !   IMAGER -- Support routine for commands COMBINE and MAP_COMBINE
  !
  ! COMBINE Out CODE In1 In2 /factor A1 A2 /THRESHOLD T1 T2 /BLANK Bval 
  !     Combine in different ways two input images
  !        (or data cubes)...
  !
  !     Out can be a file name or an existing Image variable. 
  !         The distinction is made by the existence of a "." in the name
  !         If it is a file, it is created like the In1 Variable
  !         If it is an Image variable, it must match the shape of 
  !           the In1 Variable
  !     In1 can be a file name or an existing Image variable.
  !     In2 can be a file name or an existing Image variable.
  !         The rank of In2 must be smaller than that of In1, and
  !         other dimensions must match     
  !!     
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: namex  !! Output file
  character(len=*), intent(inout) :: namey  !! Input file 1
  character(len=*), intent(inout) :: namez  !! Input file 2
  character(len=*), intent(inout) :: code   !! Combination code
  real, intent(in) :: c       !! Offset
  real, intent(inout) :: ay   !! Y Factor
  real, intent(inout) :: ty   !! Y Threshold
  real, intent(inout) :: az   !! Z Factor
  real, intent(inout) :: tz   !! Z Threshold
  logical, intent(out) :: error             !! Logical error flag
  logical, intent(in) :: resample           !! Resample 2nd image
  real, intent(inout) :: b             !! Blanking value
  logical, intent(inout) :: do_blank   !! Require Blanking
  logical, intent(in) :: relative      !! Ignore absolute positions
  !
  ! Constants
  character(len=*), parameter :: rname='MAP_COMBINE'
  real, parameter :: tole=1E-4
  real(8), parameter :: clight=299792458d-6    ! frequency in mhz
  !
  ! Local ---
  character(len=132) :: mess
  type (sic_descriptor_t) :: desc
  type (gildas) :: hx, hy, hz, ho, hspe
  type (c_ptr) :: cptr
  real, pointer :: dx(:,:), dy(:,:), dz(:,:)
  real, allocatable, target :: dres(:,:), dspe(:,:,:), dataz(:,:,:)
  logical :: x_image, y_image, z_image, found, rdonly
  logical :: do_spectral, do_spatial
  integer :: i, ier, n, sys_code
  integer(kind=index_length) :: ny, my, nz, mz, nd, np, iblank
  integer(kind=address_length) :: addr
  real :: fact, zfact, yfact
  logical :: dy_allocated, dz_allocated
  integer :: sever
  !
  ! Code ----
  error = .true.
  !
  n = len_trim(namez)
  if (n.eq.0) return
  n = len_trim(namex)
  if (n.eq.0) return
  n = len_trim(namey)
  if (n.eq.0) return
  error = .false.
  !
  z_image = .false.
  call sub_readhead (rname,namez,hz,z_image,error,rdonly,fmt_r4)
  if (error) return
  !
  y_image = .false.
  call sub_readhead (rname,namey,hy,y_image,error,rdonly,fmt_r4)
  if (error) return  
  !
  if (hz%gil%eval.ge.0.0) hz%gil%eval =   &
    max(hz%gil%eval,abs(hz%gil%bval*1e-7))
  if (hy%gil%eval.ge.0.0) hy%gil%eval =   &
    max(hy%gil%eval,abs(hy%gil%bval*1e-7))
  !
  ! Check input dimensions & spectral axis
  do_spatial = .false.
  do_spectral = .false.
  if ( (hy%gil%dim(1).ne.hz%gil%dim(1)) .or. &
    & (hy%gil%dim(2).ne.hz%gil%dim(2)) ) then
    if (resample) then
      call map_message(seve%w,rname,'Reprojecting 2nd image on 1st one grid')
      do_spatial = .true.
    else
      call map_message(seve%e,rname,'Input images are non coincident')
      error = .true.
    endif
  endif
  if (hy%gil%dim(3).ne.hz%gil%dim(3)) then
    if (hz%gil%dim(3).eq.1) then
      call map_message(seve%i,rname,'Combining a cube with a plane')
    else
      write(mess,'(A,I0,A,I0)') 'Cubes have different channel numbers: ',hy%gil%dim(3),' and ',HZ%gil%dim(3)
      if (resample) then
        do_spectral = .true.
        sever = seve%w
      else
        error = .true.
        sever = seve%e
      endif
      call map_message(sever,rname,mess)
    endif
  endif
  if (hz%gil%dim(3).ne.1) then
    if ((hy%gil%faxi.ne.0).or.(hz%gil%faxi.ne.0)) then
      !
      ! Ignore Frequency issues - Just base on Velocity sampling
      hz%gil%freq = hy%gil%freq
      hz%gil%fres = -hz%gil%vres * clight / hz%gil%freq * 1d-3
      call spectrum_consistency(rname,hy,hz,tole,error)
      if (resample.and.error) then
        do_spectral = .true.
        call map_message(seve%w,rname,'Cubes have different velocity axis')
        error = .false.
      endif
    endif
  endif
  if (error) return
  if (do_spectral) then
    call map_message(seve%w,rname,'Spectral resampling needed, but still under tests',seve%e)
  endif
  !
  ! Test also the Output
  call gildas_null(hx)
  if (index(namex,'.').eq.0) then
    x_image = .true.
    ! This must be an existing SIC Image variable
    rdonly = .false.
    call sub_readhead (rname,namex,hx,x_image,error,rdonly,fmt_r4)
    if (error) return
    !
    ! With a conforming shape with Y slot
    do i=1,max(hx%gil%ndim,hy%gil%ndim)
      if (hy%gil%dim(i).ne.hx%gil%dim(i)) then
        call map_message(seve%e,rname,'Output SIC variable does not match Input data shape')
        error = .true.
        return
      endif
    enddo
  else
    x_image = .false.
  endif
  !
  !
  ! Allocate the arrays if needed. Note that the allocated arrays do 
  ! not conform to the shape of the images, but are 2-D arrays where
  ! the second dimension is the cube planes.
  !
  nz = hz%gil%dim(1)*hz%gil%dim(2)
  ny = hy%gil%dim(1)*hy%gil%dim(2)
  mz = max(hz%gil%dim(3),1)
  my = max(hy%gil%dim(3),1)
  !
  ! Get the Y data pointer
  dy_allocated = .false.
  if (y_image) then
    call adtoad(hy%loca%addr,cptr,1)
    call c_f_pointer(cptr,dy,[ny,my])
  else
    allocate(dy(ny,my),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Y Memory allocation error')
      error = .true.
      return
    endif
    call map_message(seve%i,rname,'Reading '//trim(hy%file))
    call gdf_read_data(hy,dy,error)
    call gdf_close_image(hy,error) ! I do not need it anymore
    dy_allocated = .true.
  endif
  !
  ! Get the Z data pointer
  dz_allocated = .false.
  !
  ! Spectral resampling of second image if needed
  if (do_spectral) then
    if ((hy%gil%faxi.eq.0).or.(hz%gil%faxi.eq.0)) then
      call map_message(seve%e,rname,'Images have no Velocity axis')
      error = .true.
      return
    endif
    call gildas_null(hspe)
    call gdf_copy_header(hz,hspe,error)
    !
    ! Read in HSPE - DSPE first
    if (z_image) then
      hspe%loca%addr = hz%loca%addr
      call adtoad(hspe%loca%addr,cptr,1)
      call c_f_pointer(cptr,hspe%r3d,hspe%gil%dim(1:3))
    else
      allocate(dspe(hspe%gil%dim(1),hspe%gil%dim(2),hspe%gil%dim(3)),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Z Temporary Memory allocation error')
        error = .true.
        return
      endif
      call map_message(seve%i,rname,'Reading '//trim(hz%file))
      call gdf_read_data(hz,dspe,error)
      call gdf_close_image(hz,error) ! I do not need it anymore
      hspe%r3d => dspe
      hspe%loca%addr = locwrd(dspe)
    endif
    !
    ! Allocate DATAZ region and Convert to 3-D buffer
    allocate(dataz(hspe%gil%dim(1),hspe%gil%dim(2),my),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Z Memory allocation error')
      error = .true.
      return
    endif
    hz%r3d => dataz
    !
    ! Z is the output, SPE the input
    ! HY is only used as a spectral template
    call spectral_resample(rname,hy,hspe,hz,error)
    !
    ! MZ is now equal to MY
    mz = my
    ! Re-affect the DZ pointer to the Z data region
    hz%loca%addr = locwrd(dataz)
    call adtoad(hz%loca%addr,cptr,1)
    call c_f_pointer(cptr,dz,[nz,mz])
    !
    ! Nullify the hz%r3d pointer, and free DSPE scratch data area
    nullify(hz%r3d)
    if (.not.z_image) deallocate(dspe,stat=ier)
    hspe%loca%addr = 0
  else
    if (z_image) then
      call adtoad(hz%loca%addr,cptr,1)
      call c_f_pointer(cptr,dz,[nz,mz])
    else
      allocate(dz(nz,mz),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Z Memory allocation error')
        error = .true.
        return
      endif
      call map_message(seve%i,rname,'Reading '//trim(hz%file))
      call gdf_read_data(hz,dz,error)
      call gdf_close_image(hz,error) ! I do not need it anymore
      hz%loca%addr = locwrd(dz)
      dz_allocated = .true.
    endif
  endif
  !
  ! Spatial resampling if needed
  if (do_spatial) then
    call gildas_null(ho)
    !!Print *,'HY sizes ', hy%gil%dim(1:3), ' MY ',my, ' NY ',ny
    allocate(dres(ny,my),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'TMP Memory allocation error')
      error = .true.
      if (dy_allocated) deallocate(dy,stat=ier)
      if (dz_allocated) deallocate(dz,stat=ier)
      return
    endif
    !
    call gdf_copy_header(hz,ho,error) ! Copy Basic Header
    !!Print *,"Z unit ",hz%char%unit
    ! Copy new coordinate system and projection
    call s_reproject_init(hz,hy,ho,sys_code,error)
    !!Print *,'Done REPROJECT_INIT '
    !!call gdf_print_header(ho)
    !!Print *,"O unit ",ho%char%unit
    if (relative) then
      hz%gil%a0 = ho%gil%a0
      hz%gil%d0 = ho%gil%d0
    endif
    !
    ! Convert 3-D buffers
    addr = locwrd(dz)
    call adtoad(addr,cptr,1)
    !!Print *,'HZ sizes ', hz%gil%dim(1:3), ' MZ ',mz, ' NZ ',nz
    call c_f_pointer(cptr,hz%r3d,hz%gil%dim(1:3))
    !
    addr = locwrd(dres)
    call adtoad(addr,cptr,1)
    !!Print *,'HO sizes ', ho%gil%dim(1:3), ' MZ ',mz, ' NY ',ny
    !!Print *,'HY sizes ', hy%gil%dim(1:3), ' MY ',my
    call c_f_pointer(cptr,ho%r3d,ho%gil%dim(1:3))
    !
    call s_reproject_do(hz,hz%r3d,ho,ho%r3d,sys_code,error)
    !!Print *,"O unit ",ho%char%unit
    if (dz_allocated) then
      deallocate(dz)
    else
      nullify (dz)
    endif
    call gdf_copy_header(ho,hz,error) ! Copy back modified header
    ! Now point to the right data
    dz => dres    
    ! Reset proper pointer
    addr = locwrd(dres)
    call adtoad(addr,cptr,1)
    call c_f_pointer(cptr,hz%r3d,hz%gil%dim(1:3))
    !
    nz = ny ! In principle NZ is unused after that, though
    dz_allocated = .false.
  endif
  !
  ! Convert to Compatible units...
  call unit_to_k(hz,zfact)
  call unit_to_k(hy,yfact)
  !
  ! Now handle the Output 
  if (x_image) then
    !
    ! OK, they match 
    call adtoad(hx%loca%addr,cptr,1)    
    call c_f_pointer(cptr,dx,[ny,my])
    ! But update the Header locally
    call gdf_copy_header(hy,hx,error)
  else
    ! This is  a file, we must create it
    call gdf_copy_header(hy,hx,error)
    call sic_parsef(namex,hx%file,' ','.gdf')
    hx%gil%extr_words = 0
    hx%gil%blan_words = 2
    allocate(dx(ny,my),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'X Memory allocation error')
      if (dz_allocated) deallocate(dz,stat=ier)
      if (dy_allocated) deallocate(dy,stat=ier)
      error = .true.
      return
    endif
  endif
  !
  ay = ay*yfact
  az = az*zfact
  ! For Spectral index, change Brightness to Flux
  if (code.eq.'INDEX') then
    if (hz%char%unit.eq.'K') then
      ! Flux goes as nu^2
      az = az*(hz%gil%freq/hy%gil%freq)**2
    endif
  endif
  write(mess,*) 'Scaling Y by ',ay,yfact,' and Z by ',az,zfact
  call map_message(seve%i,rname,mess)
  !
  ! Guess a default blanking if not User specified
  if (.not.do_blank) then
    if (hz%gil%eval.ge.0) then
      b = hz%gil%bval
    else if (hy%gil%eval.ge.0) then
      b = hy%gil%bval
    else
      b = 1.2345600E+38
    endif
  endif
  !
  ! Do the actual job
  nd = ny*mz    ! Z size: 1 plane or All
  np = my/mz    ! Number of pseudo-planes
  !
  call map_message(seve%i,rname,'Combining data')
  call sub_combine(hx,hy,hz,     & ! Headers
    & nd,np,                     & ! Sizes
    & dx,dy,dz,                  & ! Data arrays
    & b,iblank,                  & ! Blanking information
    & code,ay,ty,az,tz,c,error)    ! Operation 
  !
  if (allocated(dres)) deallocate(dres,stat=ier)
  !
  ! Spectral Index
  if (code.eq.'INDEX') then
    ! Convert the ratio into a Spectral Index
    !   S   = S_0 (nu/nu0)^alpha
    !   S_z/freq_z^alpha = S_y / freq_y^alpha
    !   S_y/S_z = (freq_y/freq_z)^alpha
    !   log(S_y/S_z) = alpha log(freq_y/freq_z)
    !
    fact = 1.0/log(hy%gil%freq/hz%gil%freq)
    where ((dx.gt.0).and.(dx.ne.b))
      dx = fact*log(dx)
    else where
      dx = b
    end where
    hx%char%unit = 'INDEX'
    call map_message(seve%w,rname,'Spectral Index still under tests')
  endif
  !
  ! Update Blanking if specified
  if (iblank.ne.0) then
    do_blank = .true.
    write(mess,'(A,I0,A,I0,A)') "Found ",iblank," bad values, ",nd*np-iblank," good ones"
    call map_message(seve%i,rname,mess)
    hx%gil%bval = b
    hx%gil%eval = 0.0
  endif
  !
  ! Write ouput file
  if (.not.x_image) then
    call map_message(seve%i,rname,'Writing '//trim(hx%file))
    call gdf_write_image(hx,dx,error)
    ! Deallocating the Memory is required: this is a POINTER not an ALLOCATABLE
    deallocate(dx,stat=ier) 
    !
!NO!    Print *,'Closing Image ' !NO!    call gdf_close_image(hx,error)
  else
    ! Update the original SIC variable header, including Extrema
    error = .false. 
    hx%loca%addr = locwrd(dx)   ! Define the address
    call gdf_get_extrema (hx,error)
    call sic_descriptor(namex,desc,found)
    call gdf_copy_header(hx,desc%head,error)  
  endif
  !
  ! Free the Y and Z Pointer memory areas if Allocated (as for X)
  if (dy_allocated) deallocate(dy,stat=ier)
  if (dz_allocated) deallocate(dz,stat=ier)
  !
end subroutine do_combine
!
subroutine spectral_resample(comm,hy,hi,ho,error)
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !----------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Support for command COMBINE
  !
  ! Automatic spectral resampling of the data to be combined
  !----------------------------------------------------------------------
  character(len=*), intent(in) :: comm        !! Command name
  type(gildas), intent(in) :: hy              !! Reference cube
  type(gildas), intent(inout) :: hi           !! Cube to be resampled
  type(gildas), intent(inout) :: ho           !! Output cube
  logical, intent(out) :: error               !! Logical Error flag
  !
  ! Constants
  real(8), parameter :: clight=299792458d0
  real(4) :: dv=1.0
  !
  ! Local ---
  integer(kind=index_length) :: ipix1, ipixn, nc, mrange(2)
  real(8) :: oconv(3), iconv(3), pix1, pixn, zref, zinc, zval
  integer, allocatable :: ipi(:,:)
  real, allocatable :: ipr (:,:)
  integer :: ier
  character(len=132) :: chain
  !
  ! Code ----
  error = .false.
  if (.not.associated(ho%r3d)) then
    call map_message(seve%e,comm,'HO%R3D is not associated')
    error = .true.
  endif
  if (.not.associated(hi%r3d)) then
    call map_message(seve%e,comm,'HZ%R3D is not associated')
    error = .true.
  endif
  if (error) return
  !
  if (hy%gil%faxi.ne.0) then
    if (abs(hi%gil%freq-hy%gil%freq).gt.1d-5) then  !10 Hz tolerance
      write(chain,'(A,F15.6,A,F15.6,A)') 'Rest frequency of 1st image ', &
      & hy%gil%freq,' does not match that of 2nd ',hi%gil%freq
      call map_message(seve%w,comm,chain)
    endif
    nc = hy%gil%dim(hy%gil%faxi)             ! For Data cubes
    oconv = hy%gil%convert(:,hy%gil%faxi)
    oconv(2) = hy%gil%voff
    oconv(3) = hy%gil%vres
  else
    call map_message(seve%e,comm,'Reference image has no Velocity axis')
    error = .true.
    return
  endif
  !
  ! oconv(3) is initially on a Velocity Scale.
  ho%gil%voff = oconv(2)
  ho%gil%vres = oconv(3)
  ho%gil%fres = - ho%gil%vres * 1d3 / clight * ho%gil%freq
  ho%gil%convert(:,3) = oconv
  ho%gil%dim(3) = nc
  !
  iconv = hi%gil%convert(:,3)   ! Save Frequency/Velocity axis
  zref = hi%gil%ref(3)
  zinc = hi%gil%vres
  zval = hi%gil%voff
  hi%gil%convert(:,3) = [zref,zval,zinc]
  !
  ! Check limits
  pix1 = ho%gil%ref(3) + ( zval+ (1.d0-zref)*zinc - ho%gil%val(3) )/ho%gil%inc(3)
  pixn = ho%gil%ref(3) + ( zval+ (hi%gil%dim(3)-zref)*zinc - ho%gil%val(3) )/ho%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),ho%gil%dim(3))
  else
    ipixn = min(int(pix1),ho%gil%dim(3))
    ipix1 = int(pixn)
    if (ipix1.ne.pixn) ipix1 = ipix1+1
    ipix1 = max(ipix1,1)
  endif
  !
  allocate (ipi(2,ho%gil%dim(3)), ipr(4,ho%gil%dim(3)), stat=ier)
  !
  mrange(1) = ipix1
  mrange(2) = ipixn
  !
  call map_operation('MAP_RESAMPLE',ho,ho%r3d,hi,hi%r3d,mrange,dv)
  !
  ! Restore Frequency/Velocity Axis
  hi%gil%convert(:,3) = iconv
end subroutine spectral_resample
!
subroutine sub_combine(hx,hy,hz,n,m,dx,dy,dz,b,iblank,code,ay,ty,az,tz,c,error)
  use gkernel_types
  !----------------------------------------------------------------------
  !*
  ! IMAGER  -- Support routine for commands  
  ! COMBINE Out CODE In1 In2 /FACTOR A1 A2 /THRESHOLD T1 T2 /BLANK Bval
  !!
  !----------------------------------------------------------------------
  character(len=*), intent(inout) :: code    !! Combination code
  integer(kind=index_length), intent(in) :: n  !! Size of image
  integer(kind=index_length), intent(in) :: m  !! Number of channels
  type(gildas), intent(inout) :: hx    !! Output header
  type(gildas), intent(in) :: hy    !! Input Cube header
  type(gildas), intent(in) :: hz    !! Input Cube or Plane header
  !
  real, intent(in) :: dx(n,m)       !! Output data
  real, intent(in) :: dy(n,m)       !! Input data
  real, intent(in) :: dz(n)         !! Input data
  real, intent(in) :: c             !! Offset
  real, intent(in) :: ay            !! Y Factor
  real, intent(in) :: ty            !! Y Threshold
  real, intent(in) :: az            !! Z Factor
  real, intent(in) :: tz            !! Z Threshold
  real, intent(in) :: b  !! Output blanking
  integer(kind=index_length), intent(inout) :: iblank  !! Number of blanked pixels
  logical, intent(out) :: error  ! Logical error flag
  !
  error = .false.
  hx%gil%bval = b
  select case(code)
  case ('ADD','PLUS') 
    call add002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c,iblank)
  case ('DIVIDE','OVER','INDEX')
    hx%char%unit = 'RATIO'
    call div002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c,iblank)
  case ('MULTIPLY','TIMES') 
    call mul002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c,iblank)
  case ('OPTICAL_DEPTH') 
    hx%char%unit = 'OPACITY'
    call opt002(dz,dy,dx,   &
      n,m,   &
      hz%gil%bval,hz%gil%eval,az,tz,   &
      hy%gil%bval,hy%gil%eval,ay,ty,   &
      hx%gil%bval,c,iblank)
  case default
    Print *,code//' not available'
    error = .true.
    return
  end select
  !
end subroutine sub_combine
!
subroutine add002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c,iblank)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  !! GDF  -- Internal routine  
  !!    Linear combination of input arrays  
  !!  X = Ay*Y + Az*Z + C 
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      !! Plane array
  real :: y(n,m)                    !! Input Cube
  real :: x(n,m)                    !! Output Cube
  real :: bz                        !! Z Blanking value
  real :: ez                        !! Z Tolerance on blanking
  real :: az                        !! Z factor
  real :: tz                        !! Z threshold
  real :: by                        !! Y Blanking value
  real :: ey                        !! Y Tolerance on blanking
  real :: ay                        !! Y factor
  real :: ty                        !! Y Threshold
  real :: bx                        !! X Blanking
  real :: c                         !! Constant Offset
  integer(kind=index_length), intent(inout) :: iblank !! Number of bad pixels
  !
  ! Local ---
  integer(kind=index_length) :: i,k
  integer(kind=index_length) :: zb,zl,yb,yl
  !
  ! Code ----
  iblank = 0
  zb = 0
  yb = 0
  zl = 0
  yl = 0
  !
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,az,ay,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k) &
  !$OMP REDUCTION (+:zb,yb,zl,yl)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).le.ez) then
        zb = zb+1
        x(i,k) = bx
      else if (abs(y(i,k)-by).le.ey) then
        yb = yb+1
        x(i,k) = bx
      else if (z(i).lt.tz) then
        zl = zl+1
        x(i,k) = bx
      else if (y(i,k).lt.ty) then
        yl = yl+1
        x(i,k) = bx
      else
        x(i,k) = ay*y(i,k) + az*z(i)  +  c
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  iblank = zb+yb+zl+yl
  !TEST!Print *,'Zbad ',zb,' Ybad ',yb,' Zlow ',zl,' Ylow ',yl
end subroutine add002
!
subroutine div002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c,iblank)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  !! GDF  -- Internal routine
  !!    Division of 2 input arrays  
  !!  X = Ay*Y / Az*Z + C  
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      !! Plane array
  real :: y(n,m)                    !! Input Cube
  real :: x(n,m)                    !! Output Cube
  real :: bz                        !! Z Blanking value
  real :: ez                        !! Z Tolerance on blanking
  real :: az                        !! Z factor
  real :: tz                        !! Z threshold
  real :: by                        !! Y Blanking value
  real :: ey                        !! Y Tolerance on blanking
  real :: ay                        !! Y factor
  real :: ty                        !! Y Threshold
  real :: bx                        !! X Blanking
  real :: c                         !! Constant Offset
  integer(kind=index_length), intent(inout) :: iblank !! Number of bad pixels
  !
  ! Local ---
  integer(kind=index_length) :: i,k
  integer(kind=index_length) :: zb,zl,yb,yl
  real :: ayz
  !
  ! Code ----
  ayz = ay/az
  iblank = 0
  zb = 0
  yb = 0
  zl = 0
  yl = 0
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,ayz,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k) & 
  !$OMP REDUCTION (+:zb,zl,yb,yl)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).le.ez) then
        zb = zb+1
        x(i,k) = bx
      else if (abs(y(i,k)-by).le.ey) then
        yb = yb+1
        x(i,k) = bx
      else if (z(i).lt.tz) then
        zl = zl+1
        x(i,k) = bx
      else if (y(i,k).lt.ty) then
        yl = yl+1
        x(i,k) = bx
      else
        x(i,k) = ayz * y(i,k) / z(i)  +  c
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  iblank = zb+yb+zl+yl
end subroutine div002
!
subroutine mul002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c,iblank)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  !! GDF  -- Internal routine  
  !!  Multiplication of input arrays  
  !!  X = Ay*Y * Az*Z + C
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      !! Plane array
  real :: y(n,m)                    !! Input Cube
  real :: x(n,m)                    !! Output Cube
  real :: bz                        !! Z Blanking value
  real :: ez                        !! Z Tolerance on blanking
  real :: az                        !! Z factor
  real :: tz                        !! Z threshold
  real :: by                        !! Y Blanking value
  real :: ey                        !! Y Tolerance on blanking
  real :: ay                        !! Y factor
  real :: ty                        !! Y Threshold
  real :: bx                        !! X Blanking
  real :: c                         !! Constant Offset
  integer(kind=index_length), intent(inout) :: iblank !! Number of bad pixels
  !
  ! Local ---
  integer(kind=index_length) :: i,k
  integer(kind=index_length) :: zb,zl,yb,yl
  real :: ayz
  !
  ! Code ----
  ayz = ay*az
  iblank = 0
  zb = 0
  yb = 0
  zl = 0
  yl = 0
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,ayz,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k) &
  !$OMP REDUCTION (+:zb,zl,yb,yl)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).le.ez) then
        zb = zb+1
        x(i,k) = bx
      else if (abs(y(i,k)-by).le.ey) then
        yb = yb+1
        x(i,k) = bx
      else if (z(i).lt.tz) then
        zl = zl+1
        x(i,k) = bx
      else if (y(i,k).lt.ty) then
        yl = yl+1
        x(i,k) = bx
      else
        x(i,k) = ayz * z(i) * y(i,k) +  c
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  iblank = zb+yb+zl+yl
end subroutine mul002
!
subroutine opt002(z,y,x,n,m,bz,ez,az,tz,by,ey,ay,ty,bx,c,iblank)
  !$ use omp_lib
  use gkernel_types
  !---------------------------------------------------------------------
  !! GDF -- Internal routine  
  !!  Optical depth from input arrays  
  !!  X = - LOG ( Ay*Y / Az*Z + C )  
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: n
  integer(kind=index_length), intent(in) :: m
  real :: z(n)                      !! Plane array
  real :: y(n,m)                    !! Input Cube
  real :: x(n,m)                    !! Output Cube
  real :: bz                        !! Z Blanking value
  real :: ez                        !! Z Tolerance on blanking
  real :: az                        !! Z factor
  real :: tz                        !! Z threshold
  real :: by                        !! Y Blanking value
  real :: ey                        !! Y Tolerance on blanking
  real :: ay                        !! Y factor
  real :: ty                        !! Y Threshold
  real :: bx                        !! X Blanking
  real :: c                         !! Constant Offset
  integer(kind=index_length), intent(inout) :: iblank !! Number of bad pixels
  !
  ! Local ---
  real :: v
  integer(kind=index_length) :: i,k
  integer(kind=index_length) :: zb,zl,yb,yl
  real :: ayz
  !
  ! Code ----
  ayz = ay/az
  iblank = 0
  zb = 0
  yb = 0
  zl = 0
  yl = 0
  !$OMP PARALLEL DEFAULT(none)                    &
  !$OMP SHARED (z,x,y, bz,ez,by,ey,tz,ty,ayz,bx,c) &
  !$OMP SHARED (n,m) PRIVATE (i,k,v) &
  !$OMP REDUCTION (+:iblank,zb,zl,yb,yl)
  !$OMP DO
  do k=1,m
    do i=1,n
      if (abs(z(i)-bz).le.ez) then
        zb = zb+1
        x(i,k) = bx
      else if (abs(y(i,k)-by).le.ey) then
        yb = yb+1
        x(i,k) = bx
      else if (z(i).lt.tz) then
        zl = zl+1
        x(i,k) = bx
      else if (y(i,k).lt.ty) then
        yl = yl+1
        x(i,k) = bx
      else
        v = ayz * y(i,k) / z(i)  +  c
        if (v.gt.0.0) then
          x(i,k) = - log( v )
        else
          x(i,k) = bx
          iblank = iblank+1
        endif
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  iblank = iblank+zb+yb+zl+yl
end subroutine opt002
!
subroutine sub_readhead(rname,namez,hz,z_image,error,rdonly,fmt,type)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  !     IMAGER -- Utility routine  
  !   Return the Header of a GILDAS File or SIC Image variable
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname     !! Caller name
  character(len=*), intent(in) :: namez     !! Name of File or Variable
  type(gildas), intent(out) :: hz           !! GILDAS Header
  logical, intent(inout) :: z_image         !! Is it a SIC image variable ?
  logical, intent(out) :: error             !! Error flag
  logical, intent(out), optional :: rdonly  !! Ask for ReadOnly status
  integer, intent(in), optional :: fmt      !! Required format
  character(len=*), intent(in), optional :: type   !! File extension
  !
  ! Local ---
  logical :: found
  type (sic_descriptor_t) :: desc
  integer :: i
  character(len=16) :: atype
  !
  ! Code ----
  !
  ! Search if any SIC variable like this one...
  call sic_descriptor(namez,desc,found)
  if (found) then
    if (.not.associated(desc%head)) then
      call map_message(seve%e,rname,  &
        'Variable '//trim(namez)//' does not provide a header')
      found = .false.
    else if (present(fmt)) then
      if (desc%type.ne.fmt) then
        call map_message(seve%e,rname,  &
          'Variable '//trim(namez)//' is of wrong type')
        found = .false.
      endif
    endif
    if (found) then
      if (abs(desc%head%gil%type_gdf) .eq. code_gdf_uvt) then
        call gildas_null(hz,type='UVT')
      else
        call gildas_null(hz)
      endif
      call gdf_copy_header(desc%head,hz,error)
      if (error) return
      hz%loca%addr = desc%addr
      z_image = .true.
      if (present(rdonly)) rdonly = desc%readonly
      ! Reset Size in the HEADER also
      hz%gil%ndim = desc%ndim
      hz%gil%dim = 1
      hz%loca%size = 1
      do i=1,hz%gil%ndim
        hz%gil%dim(i) = desc%dims(i)
        hz%loca%size = hz%loca%size * hz%gil%dim(i)
      enddo
    endif
  endif
  !
  ! If not, fall back on File, unless Image mode is specified
  if (.not.found) then
    if (z_image) then
      call map_message(seve%e,rname, 'No such Variable '//trim(namez))
      error = .true.
      return
    else
      if (present(type)) then
        atype = type
      else
        atype = '.gdf'
      endif
      !
      call sic_parse_file(namez,' ',atype,hz%file)
      call gdf_read_header(hz,error)
      if (error) then
        call map_message(seve%e,rname,'Cannot read input file '//trim(hz%file))
        return
      endif
    endif
  endif
end subroutine sub_readhead
!
subroutine unit_to_k(hin,fact)
  use image_def
  ! @ private
  !*
  !   IMAGER -- Utility routine
  !     Get the Unit to Kelvin conversion factor - Returns 1 if none.
  !!
  type(gildas), intent(inout) :: hin  !! Gildas header
  real, intent(out) :: fact           !! Conversion factor
  !
  character(len=12) :: unit
  real :: beam, lambda, jyperk
  !
  unit = hin%char%unit
  call sic_upper(unit)
  !
  select case (unit)
  case ('JY/BEAM')
    call get_jyperk(hin,beam,jyperk)
    if (jyperk.eq.0) then
      fact = 1.0
    else
      lambda = 2.99792458e8/hin%gil%freq*1e-6
      fact = 1.0/jyperk
      hin%char%unit = 'K'
    endif
  case ('JY/PIXEL')
    beam = abs(hin%gil%inc(1)*hin%gil%inc(2))
    lambda = 2.99792458e8/hin%gil%freq*1e-6
    jyperk = 2.0*1.38023e3*beam/lambda**2.
    fact = 1.0/jyperk
    hin%char%unit = 'K'
  case ('MJY/STERADIA','MJY/SR')
    beam = 1.0
    lambda = 2.99792458e8/hin%gil%freq*1e-6
    jyperk = 2.0*1.38023e3*beam/lambda**2.
    fact = 1.0E6/jyperk
    hin%char%unit = 'K'
  case ('K')
    fact = 1.0
  case default
    fact = 1.0
  end select
end subroutine unit_to_k
