subroutine get_gildas(rname,cinp,desc,hin,error)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER  -- GILDAS tool  
  !   General tool to incarnate the SIC variable into a Gildas 
  !   derived type Fortran variable
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname           !! Input caller name
  character(len=*), intent(in) :: cinp            !! Input variable name
  type(sic_descriptor_t), intent(out) :: desc     !! Descriptor
  type(gildas), intent(inout) :: hin              !! Gildas header 
  logical, intent(inout) :: error                 !! Error flag 
  !
  ! Local ---
  logical :: found
  !
  ! Code ----
  !
  ! Look at the SIC variable
  call sic_descriptor(cinp,desc,found)  
  if (.not.found) then
    call map_message(seve%e,rname,'No such SIC variable '//cinp)
    error = .true.
    return
  endif
  !
  ! If the descriptor is here, copy the Header in HIN
  if (.not.associated(desc%head)) then
    call map_message(seve%w,rname,  &
      'Variable '//trim(cinp)//' does not provide a header')
    call gildas_null(hin)
    ! This will be a simple Table
    hin%gil%form = desc%type              ! Variable type
    hin%gil%ndim = desc%ndim
    hin%gil%dim(1:desc%ndim) = desc%dims(1:desc%ndim)
  else
    !
    ! Locate the header - data area is given by desc%addr
    if (abs(desc%head%gil%type_gdf).eq.abs(code_gdf_uvt)) then
      call gildas_null(hin,type='UVT')
    else
      call gildas_null(hin)
    endif
    call gdf_copy_header(desc%head,hin,error)
  endif
end subroutine get_gildas
!
subroutine specify_comm(line,error)
  use gkernel_interfaces
  use imager_interfaces, only : map_message 
  use phys_const
  use clean_arrays
  use clean_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER   -- Support for command SPECIFY [Buffer|File|*] KeyWord Value
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line  !! Command line
  logical, intent(out) :: error            !! Logical error flag
  !
  ! Constants
  integer, parameter :: o_for=1
  character(len=*), parameter :: rname = 'SPECIFY'
  integer, parameter :: icode_uv=1, icode_dirty=2, icode_clean=3, icode_sky=4, icode_all=5
  integer, parameter :: code_blank=0, code_scale=1
  integer, parameter :: nterm=7
  integer, parameter :: ncode=5
  character(len=12) :: cunits(5),lunits(5)
  data cunits /'K           ','JY/BEAM     ','JY/PIXEL    ','MJY/STERADIA','MJY/SR      '/
  data lunits /'K           ','Jy/beam     ','Jy/pixel    ','MJy/Steradia','MJy/Sr      '/
  character(len=12) :: term(nterm)
  data term/'FREQUENCY', 'LINENAME', 'TELESCOPE', 'VELOCITY','BLANKING', 'SPECUNIT', 'UNIT'/
  !
  ! Local ---
  character(len=varname_length) :: arg
  character(len=filename_length) :: fich
  character(len=8) :: ctype, ounit
  character(len=12) :: chain,key,cline,clines(ncode), spec_type
  integer :: i, iterm, narg, nc, nf, ista, iopt
  real(8) :: freq, freq_a,freq_b,value(3)
  real(4) :: velo, bval
  real(8) :: freqs(ncode)
  real(4) :: velos(ncode)
  logical :: do_freq, do_line, do_velo, do_freqs, do_blank, do_odd, found, err
  logical :: do_uv, do_dirty, do_clean, do_sky, do_one, do_cont, do_spec, do_unit, do_file
  type(sic_descriptor_t) :: desc, descuv   ! Descriptor
  type(gildas) :: hin, hou
  integer :: iloop, nblock, new_nhb, ier
  real, allocatable :: din(:,:)
  real :: fact, fact_k, fact_u
  !
  ! Code ---
  freq = 0.d0
  velo = -1.e9                     ! An impossible velocity
  do_freq = .false.
  do_line = .false.
  do_velo = .false.
  do_dirty = .false.
  do_clean = .false.
  do_sky = .false.
  do_uv = .false.
  do_blank = .false.
  do_freqs = .false.
  do_cont = .false.  ! Continuum image
  do_spec = .false.
  do_unit = .false.
  !
  do_one = sic_present(o_for,0)
  ! Odd number of arguments ?
  narg = sic_narg(0)
  do_odd = mod(narg,2).eq.1
  if (do_one) then
    if (do_odd) then
      call map_message(seve%e,'SPECIFY','deprecate /FOR option is invalid in this context')
      iopt = 0
      ista = 2
    else
      call map_message(seve%w,'SPECIFY','option /FOR is deprecated, converting to alternate syntax')
      iopt = o_for
      ista = 1
    endif
  else if (do_odd) then
    iopt = 0
    ista = 2
    do_one = .true.
  else
    ista = 1
  endif
  if (do_one) then
    ! Get variable or file name - First argument (of command or deprecated /FOR option)
    call sic_ch(line,iopt,1,fich,nf,.true.,error)
    if (error) return
    if (index(fich,'.').ne.0) then
      do_file = .true.
    else if (fich.eq.'*') then
      do_one = .false.
    else
      call sic_upper(fich)
      do_file = .false.
    endif
  endif
  !
  ! * argument (implicitely if an even number of arguments)
  if (.not.do_one) then
    do_file = .false.
    if (hcont%loca%size.ne.0) do_cont = .true.
    if (hdirty%loca%size.ne.0) then
      freq = hdirty%gil%freq
      velo = hdirty%gil%voff
      cline = hdirty%char%line
      clines(icode_dirty) = hdirty%char%line
      freqs(icode_dirty) = freq
      velos(icode_dirty) = velo
      do_dirty = .true.
    endif
    if (hclean%loca%size.ne.0) then
      freq = hclean%gil%freq
      velo = hclean%gil%voff
      cline = hclean%char%line
      clines(icode_clean) = hclean%char%line
      freqs(icode_clean) = freq
      velos(icode_clean) = velo
      do_clean = .true.
    endif
    if (hsky%loca%size.ne.0) then
      freq = hsky%gil%freq
      velo = hsky%gil%voff
      cline = hsky%char%line
      clines(icode_sky) = hsky%char%line
      freqs(icode_sky) = freq
      velos(icode_sky) = velo
      do_sky = .true.
    endif
    !
    ! UV data must be last, to be pre-dominant in case a new UV
    ! table has been read, but Images are not yet recomputed.
    !
    ! Some warning should be given then
    if (huv_current%loca%size.ne.0) then
      if (freq.ne.0 .and. abs(freq-huv_current%gil%freq).gt.1.d0) then  ! MHz
        call map_message(seve%w,rname,'Images and UV data have different frequencies')
      endif
      freq = huv_current%gil%freq
      if (velo.ne.-1e9 .and. abs(velo-huv_current%gil%voff).gt.1.d-3) then ! km/s
        call map_message(seve%w,rname,'Images and UV data have different velocity frames')
      endif
      velo = huv_current%gil%voff
      cline = huv_current%char%line
      clines(icode_uv) = huv_current%char%line
      freqs(icode_uv) = freq
      velos(icode_uv) = velo
      do_uv = .true.
    endif
  endif
  !
  do i = ista, narg, 2
    call sic_ke(line,0,i,chain,nc,.true.,error)
    if (error) return
    call sic_ambigs(rname,chain,key,iterm,term,nterm,error)
    if (error) return
    !
    select case (key)
    case ('FREQUENCY')
      call sic_ke(line,0,i+1,arg,nc,.true.,error)
      if (error) return
      !
      ! Look at the SIC variable holding the Frequencies
      call sic_descriptor(arg,desc,found)
      if (.not.found) then
        ! A plain number
        call sic_r8(line,0,i+1,freq,.true.,error)
        if (error) return
        do_freq = .true.
      else if (desc%type.ne.fmt_r8) then
        call map_message(seve%e,rname,'SIC variable '//arg(1:nc)//' is not DOUBLE')
        error = .true.
        return
      else if (desc%size.eq.2) then
        ! Check if size is a single 64-bit word
        call sic_r8(line,0,i+1,freq,.true.,error)
        if (error) return
        do_freq = .true.
      else if (sic_narg(0).ne.2) then
        call map_message(seve%e,rname,'SPECIFY FREQUENCY FreqListArray is exclusive of other actions')
        error =.true.
        return
      else
        call map_message(seve%i,rname,'Setting per-channel frequencies from '//arg(1:nc))
        do_freqs = .true.
      endif
      !
    case ('VELOCITY')
      ! Modify Frequency scale according to new velocity (km/s)
      call sic_r4(line,0,i+1,velo,.true.,error)
      do_velo = .true.
      !
    case ('LINENAME')
      call sic_ch(line,0,i+1,cline,nc,.true.,error)
      do_line = .true.
      !
    case ('TELESCOPE')
      if (narg.gt.2) then
        call map_message(seve%e,rname,'TELESCOPE keyword is exclusive of other keywords')
        error = .true.
        return
      endif
      call sic_ke(line,0,i+1,chain,nc,.true.,error)
      if (error) return
      !
      if (do_one) then
        if (do_file) then
          call map_message(seve%e,rname,'SPECIFY TELESCOPE not yet supported for file')
          error = .true.
          return
        else
          arg = fich
          !
          ! Look at the SIC variable
          call sic_descriptor(fich,desc,found)
          if (.not.found) then
            call map_message(seve%e,rname,'No such SIC variable '//arg(1:nc))
            error = .true.
            return
          endif
          !
          ! There must be a Header in the descriptor...
          if (.not.associated(desc%head)) then
            call map_message(seve%w,rname,  &
              'Variable '//arg(1:nc)//' does not provide a header')
            error = .true.
            return
          endif
          call gdf_setteles(desc%head,chain(1:nc),value,error)
        endif
      else
        !
        ! Update current UV and Initial UV data set if needed
        if (do_uv) then
          if (huv_current%gil%nteles.ge.1) then
            if (huv_current%gil%teles(1)%ctele .ne. chain(1:nc)) then
              call map_message(seve%i,rname,'Telescope ' &
              & //trim(huv_current%gil%teles(1)%ctele) &
              & //' in UV data overwritten by SPECIFY TELESCOPE '//chain(1:nc)) 
              ! Undefine the telescope so that all characteristics
              ! are re-defined by gdf_addteles after
              huv_current%gil%teles(1)%ctele = ' '
              huv_init%gil%teles(1)%ctele = ' '
            endif
          endif
          call gdf_addteles(huv_current,'TELE',chain(1:nc),value,error)
          call gdf_addteles(huv_init,'TELE',chain(1:nc),value,error)
        endif
        if (do_dirty) call gdf_setteles(hdirty,chain(1:nc),value,error)
        if (do_clean) call gdf_setteles(hclean,chain(1:nc),value,error)
        if (do_cont) call gdf_setteles(hcont,chain(1:nc),value,error)
        if (do_dirty) call gdf_setteles(hdirty,chain(1:nc),value,error)
      endif
      return
      !
    case ('BLANKING','SPECUNIT','UNIT')
      if (narg-ista.ne.1) then
        call map_message(seve%e,rname,'SPECIFY '//trim(key)//' is exclusive of other actions')
        error =.true.
      endif
      if (.not.do_one) then
        call map_message(seve%e,rname,'SPECIFY '//trim(key)//' requires a Buffer name')
        error =.true.
      endif
      if (error) return
      call sic_ke(line,0,i+1,arg,nc,.true.,error)
      !
      if (key.eq.'BLANKING') then
        call sic_r4(line,0,i+1,bval,.true.,error)
        if (error) return
        do_blank = .true.
      else if (key.eq.'SPECUNIT') then
        call sic_ambigs(rname,arg,spec_type,nc,['FREQUENCY ','VELOCITY  '],2,error)
        do_spec = .true.
      else if (key.eq.'UNIT') then
        call sic_ambigs(rname,arg,spec_type,nc, cunits, 5, error)
        do_unit = .true.
        spec_type = lunits(nc)
      endif
      if (error) return
    end select
    if (error) return
  enddo
  !
  ! FREQUENCY Array case, very specific
  if (do_freqs) then
    ! 
    ! Look at the SIC variable holding the Frequencies
    call sic_descriptor(arg,desc,found)  
    if (.not.found) then
      call map_message(seve%e,rname,'No such SIC variable '//arg(1:nc))
      error = .true.
      return
    endif
    if (desc%type.ne.fmt_r8) then
      call map_message(seve%e,rname,'SIC variable '//arg(1:nc)//' is not DOUBLE')
      error = .true.
      return
    endif
    !
    ! /FOR option
    if (do_one) then
      !
      if (do_file) then
        ! It must be a file
        call gildas_null(hou,type='UVT')
        hou%file = fich
        !
        call gdf_read_header(hou,error)
        if (error)  return
        !
        ! Test if in-place work is possible
        new_nhb = 2 + (3*desc%dims(1)+ 2+10*hou%gil%nteles + 127)/128   ! Total number of HEADER blocks required...
        if (new_nhb.gt.hou%gil%nhb) then
          !
          ! A copy of the file is required - preceded or followed by renaming...
          call gdf_close_image(hou,error)
          !
          error = .false.    ! Indicate that Header Extension IS allowed
          call gdf_setfreqs(rname,desc,hou,error)
          if (error) return
          !
          call gildas_null(hin,type='UVT')
          hin%file = trim(arg)//'.old'
          ier = gag_filrename(hou%file,hin%file)
          !
          ! Read the header again (to get the proper NVB, actually)
          call gdf_read_header(hin,error)
          if (error) return
          !
          ! OK copy the whole stuff...
          call gdf_nitems('SPACE_GILDAS',nblock,hin%gil%dim(1))
          nblock = min(nblock,hin%gil%dim(2))
          !
          allocate (din(hin%gil%dim(1),nblock),stat=ier)
          if (ier.ne.0) then
            call map_message(seve%e,rname,'Memory allocation error ')
            error = .true.
            return
          endif
          !
          hin%blc = 0
          hin%trc = 0
          hou%blc = 0
          hou%trc = 0
          call gdf_create_image(hou,error)
          if (error) return
          !
          call map_message(seve%i,rname,'Copying UV data ')
          do iloop = 1,hin%gil%dim(2),nblock
            hin%blc(2) = iloop
            hin%trc(2) = min(iloop+nblock-1,hin%gil%dim(2))
            hou%blc(2) = iloop
            hou%trc(2) = hin%trc(2)
            call gdf_read_data (hin,din,error)
            if (error) exit
            call gdf_write_data (hou,din, error)
            if (error) exit
          enddo
          err = .false.
          call gdf_close_image(hou,err)
          error = err.or.error
          !
          ! Remove the old file, or get back to it in case of failure
          if (error) then
            ier = gag_filrename(hin%file,hou%file)
          else
            call gag_filrm(hin%file)
          endif
        else
          !
          ! In place header update
          error = .true.    ! Indicate that Header Extension is NOT allowed
          call gdf_setfreqs(rname,desc,hou,error)
          if (.not.error) call gdf_update_header(hou,error)
          err = .false.
          call gdf_close_image(hou,err)
          error = err.or.error
        endif
      else
        !
        ! It must be a SIC variable
        call sic_descriptor(arg,descuv,found)  
        if (.not.found) then
          call map_message(seve%e,rname,'No such SIC variable '//arg(1:nc))
          error = .true.
          return
        endif
        !
        ! There must be a Header in the descriptor... 
        if (.not.associated(descuv%head)) then
          call map_message(seve%w,rname,  &
            'Variable '//arg(1:nc)//' does not provide a header')
          error = .true.
          return
        endif
        error = .true.    ! Indicate that Header Extension is NOT allowed
        call gdf_setfreqs(rname,desc,descuv%head,error)
      endif
      !
    else
      !
      call sic_delvariable('UV',.false.,error)
      error = .false.    ! Indicate that Header Extension IS allowed
      call gdf_setfreqs(rname,desc,huv_current,error)
      err = .false.
      call sic_mapgildas('UV',huv_current,err,duv)
      error = err.or.error
    endif
    return
  endif
  !
  ! Single Buffer Case
  if (do_one) then
    if (do_file) then
      call map_message(seve%w,rname,'SPECIFY FileName Item Value -- still experimental')
      allocate(desc%head,stat=ier)
      call gildas_null(desc%head)
      desc%head%file = fich
      call gdf_read_header(desc%head,error)
      if (error) return
      !
      ctype = 'File'
    else
      arg = fich
      nc = len_trim(arg)
      !
      ! Look at the SIC variable
      call sic_descriptor(arg,desc,found)
      if (.not.found) then
        call map_message(seve%e,rname,'No such SIC variable '//arg(1:nc))
        error = .true.
        return
      endif
      !
      ! There must be a Header in the descriptor...
      if (.not.associated(desc%head)) then
        call map_message(seve%w,rname,  &
          'Variable '//arg(1:nc)//' does not provide a header')
        error = .true.
        return
      endif
      !
      ctype = 'Variable '
    endif
    !
    if (do_spec) then
      if (desc%head%gil%faxi.eq.0) then
        call map_message(seve%w,rname,  &
          ctype//fich(1:nf)//' has no Spectral axis')
        error = .true.
        return
      endif
      !
      if (spec_type.eq.'VELOCITY') then
        desc%head%gil%convert(2,desc%head%gil%faxi) = desc%head%gil%voff
        desc%head%gil%convert(3,desc%head%gil%faxi) = desc%head%gil%vres
        desc%head%char%code(desc%head%gil%faxi) = 'VELOCITY'
      else
        desc%head%gil%convert(2,desc%head%gil%faxi) = desc%head%gil%freq
        desc%head%gil%convert(3,desc%head%gil%faxi) = desc%head%gil%fres
        desc%head%char%code(desc%head%gil%faxi) = 'FREQUENCY'
      endif
    else if (do_unit) then
      !
      ! Convert from Jy/area to K or vice-versa
      ounit = desc%head%char%unit
      if (desc%head%char%unit.ne."K") then
        ! Convert from some Jy per Area unit to K
        call unit_to_k(desc%head,fact_k)
      else
        fact_k = 1.0
      endif
      ! Then convert from K to desired unit, if needed
      desc%head%char%unit = spec_type
      call unit_to_k(desc%head,fact_u)
      !
      ! And restore desired unit in header
      fact = fact_k/fact_u
      desc%head%char%unit = spec_type
      if (fact.eq.1.0) then
        call map_message(seve%i,'SPECIFY','No conversion required')
      else
        call map_message(seve%w,'SPECIFY','Converting from '//trim(ounit)//' to '//spec_type)
        call modify_scale_blank(desc,fact,error,code_scale)
      endif
    else if (do_blank) then
      call modify_scale_blank(desc,bval,error,code_blank)
    else
      !
      if (.not.do_freq) freq = desc%head%gil%freq
      if (.not.do_velo) velo = desc%head%gil%voff
      if (.not.do_line) cline = desc%head%char%line
      !
      clines(icode_all) = cline
      freqs(icode_all) = freq
      velos(icode_all) = velo
      call gdf_modify(desc%head,velos(icode_all),freqs(icode_all),error=error)
      desc%head%char%line = clines(icode_all)
    endif
    !
    if (ctype.eq.'File') then
      if (error) then
        call gdf_close_image(desc%head,err)
      else
        call gdf_update_header(desc%head,error)
        call gdf_close_image(desc%head,error)
      endif
    endif
    !
  else
    !
    ! Update all available buffers - multiple modifications at once
    if (do_freq) freqs = freq
    if (do_velo) velos = velo
    if (do_line) clines = cline
    !
    if (do_uv) then  !!  if (huv_current%loca%size.ne.0) then
      freq_b = gdf_uv_frequency(huv_current,1.d0)
      call gdf_modify(huv_current,velos(icode_uv),freqs(icode_uv),error=error)
      freq_a = gdf_uv_frequency(huv_current,1.d0)
      if (abs(freq_a-freq_b).gt.10.0) then
        Print *,'Frequency Before ',freq_b
        Print *,'Frequency After ',freq_a
        Print *,'Frequency Difference ',freq_a-freq_b
      endif
      huv_current%char%line = clines(icode_uv)
    endif
    if (do_dirty) then
      call gdf_modify(hdirty,velos(icode_dirty),freqs(icode_dirty),error=error)
      hdirty%char%line = clines(icode_dirty)
    endif
    if (do_clean) then
      call gdf_modify(hclean,velos(icode_clean),freqs(icode_clean),error=error)
      hclean%char%line = clines(icode_clean)
    endif
    if (do_sky) then
      call gdf_modify(hsky,velos(icode_sky),freqs(icode_sky),error=error)
      hsky%char%line = clines(icode_sky)
    endif
  endif
  !
end subroutine specify_comm
!
subroutine gdf_setfreqs(rname,desc,huv_current,error)
  use gkernel_types
  use gkernel_interfaces
  use imager_interfaces, only : map_message 
  use gbl_message
  use iso_c_binding
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER   -- GILDAS Utility
  !
  !   Set values of the Frequency section in the specified UV Buffer header.  
  !   Support for command SPECIFY UVbuffer FREQUENCIES Array
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname       !! Buffer name
  type(sic_descriptor_t), intent(in) :: desc  !! Descriptor of Frequency array
  type(gildas), intent(inout) :: huv_current          !! UV data header
  logical, intent(inout) :: error             !! Logical error flag
  !
  ! Local ---
  integer :: stoke, new_nhb, ier
  type(c_ptr) :: cptr
  real(8), pointer :: dptr(:)
  !
  ! Code ----
  !
  ! Verify Number of frequencies against number of channels of UV data
  if (desc%dims(1).ne.huv_current%gil%nchan) then
    call map_message(seve%e,rname,'Frequencies list does not match number of channels in UV data')
    error = .true.
    return
  endif
  !
  stoke = 0
  if (huv_current%gil%nstokes.eq.1) then
    if (associated(huv_current%gil%stokes)) stoke = huv_current%gil%stokes(1)
  else if (huv_current%gil%nstokes.ne.0) then
    call map_message(seve%e,rname,'FREQUENCIES only work for 1 Stokes')
    error = .true.
    return
  endif
  !
  if (huv_current%gil%nfreq.eq.0) then
    huv_current%gil%nfreq = desc%dims(1)
    allocate (huv_current%gil%freqs(huv_current%gil%nfreq),huv_current%gil%stokes(huv_current%gil%nfreq),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'FREQUENCIES allocation error')
      error = .true.
      return
    endif
    huv_current%gil%stokes = stoke
  endif
  !
  new_nhb = 2 + (3*huv_current%gil%nfreq + 2+10*huv_current%gil%nteles + 127)/128   ! Total number of HEADER blocks required...
  if (new_nhb.gt.huv_current%gil%nhb) then
    if (error) then
      call map_message(seve%e,rname,'Header cannot be extended in place')
      return
    endif
    call map_message(seve%w,rname,'Header is being extended')
  else
    call map_message(seve%d,rname,'Header is updated in place')
  endif
  !
  call adtoad(desc%addr,cptr,1)
  call c_f_pointer(cptr,dptr,[huv_current%gil%nfreq])
  huv_current%gil%freqs(:) = dptr
  call gdf_setuv(huv_current,error)
  !
end subroutine gdf_setfreqs
!
subroutine gdf_setteles(head,chain,value,error)
  use image_def
  use gkernel_interfaces, only : gdf_addteles
  use imager_interfaces, only : map_message
  use gbl_message
  ! @ private
  !! IMAGER -- GILDAS Utility -- Set the Telescope section
  !--------------------------------------------------------------------
  type(gildas), intent(inout) :: head
  !! Gildas Header
  character(len=*), intent(in) :: chain
  !! Telescope name
  real(8), intent(in) :: value(3)
  !! Telescope parameters
  logical, intent(inout) :: error
  !! Logical error flag
  !
  if (head%gil%nteles.ge.1) then
    if (head%gil%teles(1)%ctele .ne. chain) then
      if ( abs(head%gil%type_gdf).eq.abs(code_gdf_uvt) ) then        
          call map_message(seve%i,'SPECIFY','Telescope ' &
          & //trim(head%gil%teles(1)%ctele) &
          & //' in UV dataset overwritten by SPECIFY TELESCOPE '//chain)
      endif
      ! Undefine the telescope so that all characteristics
      ! are re-defined by gdf_laddteles after
      head%gil%teles(1)%ctele = ' '
    endif
  endif
  call gdf_addteles(head,'TELE',chain,value,error)
end subroutine gdf_setteles
!
subroutine modify_scale_blank(desc,scale,error,code)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use iso_c_binding
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- GILDAS Utility --  Change the Unit of data cube, or
  ! its blanking value
  ! 
  !     Support routine for SPECIFY UNIT and SPECIFY BLANKING
  !!
  !---------------------------------------------------------------------
  type(sic_descriptor_t), intent(inout) :: desc !! Descriptor of SIC variable
  real, intent(in) :: scale                     !! Scale factor for the data
  logical, intent(out) :: error                 !! Logical error flag
  integer, intent(in) :: code                   !! Keyword code
  !
  ! Local ---
  integer, parameter :: code_blank=0    !! BLANKING keyword
  integer, parameter :: code_scale=1    !! UNIT Keyword
  type(c_ptr) :: cptr 
  real(4), pointer :: rdata(:)
  integer(kind=index_length) :: j, asize, nblock
  type(gildas) :: htmp
  real :: rblock
  integer :: ier
  !
  ! Code ----
  if (desc%head%gil%form.ne.fmt_r4) then
    call map_message(seve%e,'SPECIFY','Unsupported data format')
    error = .true.
    return
  endif
  !
  if (code.eq.code_scale) then
    desc%head%gil%rmax = scale*desc%head%gil%rmax
    desc%head%gil%rmin = scale*desc%head%gil%rmin
  endif
  !
  if (desc%size.ne.0) then
    call adtoad(desc%addr,cptr,1)
    call c_f_pointer(cptr,rdata,[desc%size])
    if (code.eq.code_scale) then
      call sub_modify_scale(desc%head,rdata,desc%size,scale)
    else if (code.eq.code_blank) then
      call sub_modify_blank(desc%head,rdata,desc%size,scale)
    endif
  else
    asize = product(desc%head%gil%dim(1:desc%head%gil%ndim))
    call gildas_null(htmp,type='IMAGE')
    htmp = desc%head    ! Copy full header
    !
    ! Flatten the array to 1-D only
    htmp%gil%dim = 1
    htmp%gil%dim(1) = asize
    htmp%gil%ndim = 1
    !
    ier = sic_ramlog('SPACE_GILDAS',rblock)
    nblock = rblock*1024*256
    allocate(rdata(nblock),stat=ier)
    !
    do j=1,htmp%gil%dim(1),nblock
      htmp%blc(1) = j
      htmp%trc(1) = min(htmp%gil%dim(1),j+nblock-1)
      asize = htmp%trc(1)-htmp%blc(1)+1
      !! print *,'Block ',htmp%blc(1),htmp%trc(1),asize
      call gdf_read_data(htmp,rdata,error)
      if (error) return
      !
      if (code.eq.code_scale) then
        call sub_modify_scale(htmp,rdata,asize,scale)
      else if (code.eq.code_blank) then
        call sub_modify_blank(htmp,rdata,asize,scale)
      endif
      call gdf_write_data(htmp,rdata,error)
    enddo
  endif
  !
  if (code.eq.code_scale) then
    ! Adjust Blanking if it would fall in the new Min Max range
    if (desc%head%gil%rmin.le.desc%head%gil%bval .and. &
      & desc%head%gil%bval.le.desc%head%gil%rmax) then
      desc%head%gil%bval = scale*desc%head%gil%bval
    endif
    desc%head%gil%rms = scale*desc%head%gil%rms
    desc%head%gil%noise = scale*desc%head%gil%noise
  else
    desc%head%gil%bval = scale
    desc%head%gil%eval = 0.0
  endif
end subroutine modify_scale_blank
!
subroutine sub_modify_scale(head,rdata,rsize,scale)
  use image_def
  !
  !*
  !   IMAGER -- GILDAS Utility --  Change the Unit of data cube
  ! 
  !     Support routine for SPECIFY UNIT
  !!
  type(gildas), intent(inout) :: head   !! Cube Header
  integer(kind=index_length), intent(in) :: rsize  !! Data length
  real, intent(inout) :: rdata(rsize)   !! Data array
  real, intent(in) :: scale             !! Scale factor
  !
  ! Local ---
  integer(kind=index_length) :: i
  !
  ! Code ----
  if (head%gil%eval.lt.0) then
    do i=1,rsize
      rdata(i) = scale*rdata(i)
    enddo
  else
    ! Adjust Blanking if it would fall in the new Min Max range
    if (head%gil%rmin.le.head%gil%bval .and. &
      & head%gil%bval.le.head%gil%rmax) then
      do i=1,rsize
        rdata(i) = scale*rdata(i)
      enddo
    else
      do i=1,rsize
        if (abs(rdata(i)-head%gil%bval).gt.head%gil%eval) rdata(i) = scale*rdata(i)
      enddo
    endif
  endif
end subroutine sub_modify_scale
!
subroutine sub_modify_blank(head,rdata,rsize,bval)
  use image_def
  !*
  !   IMAGER -- GILDAS Utility --  Change the Cube blanking value
  ! 
  !     Support routine for SPECIFY BLANKING
  !!
  type(gildas), intent(inout) :: head               !! Cube Header
  integer(kind=index_length), intent(in) :: rsize   !! Data length
  real, intent(inout) :: rdata(rsize)               !! Data array
  real, intent(in) :: bval                          !! New blanking
  !
  integer(kind=index_length) :: i
  !
  do i=1,rsize
    if (abs(rdata(i)-head%gil%bval).le.head%gil%eval) rdata(i) = bval
  enddo
end subroutine sub_modify_blank
