subroutine get_gildas(rname,cinp,desc,hin,error)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! IMAGER
  ! @ public
  !   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 
  !
  logical :: found
  !
  ! 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 com_modify(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 KeyWord Value [/FOR ImageVariable] 
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line
  logical, intent(out) :: error
  !
  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 :: nterm=6
  integer, parameter :: ncode=5
  character(len=varname_length) :: arg
  character(len=12) :: term(nterm),chain,key,cline,clines(ncode)
  data term/'FREQUENCY', 'LINENAME', 'TELESCOPE', 'VELOCITY','BLANKING', 'FREQUENCIES'/
  integer :: i, iterm, narg, nc
  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, found, err
  logical :: do_uv, do_dirty, do_clean, do_sky, do_one, do_cont
  type(sic_descriptor_t) :: desc, descuv   ! Descriptor
  type(gildas) :: hin, hou
  integer :: iloop, nblock, new_nhb, ier
  real, allocatable :: din(:,:)
  !
  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_one = .false.
  do_blank = .false.
  do_freqs = .false.
  do_cont = .false.  ! Continuum image
  !
  if (sic_present(o_for,0)) then
    ! /FOR option - Get variable name
    do_one = .true.
  else
    if (hcont%loca%size.ne.0) then
      do_cont = .true.
    endif
    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%loca%size.ne.0) then
      if (freq.ne.0 .and. abs(freq-huv%gil%freq).gt.1.d0) then  ! MHz
        call map_message(seve%w,rname,'Images and UV data have different frequencies')
      endif
      freq = huv%gil%freq
      if (velo.ne.-1e9 .and. abs(velo-huv%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%gil%voff
      cline = huv%char%line
      clines(icode_uv) = huv%char%line
      freqs(icode_uv) = freq
      velos(icode_uv) = velo
      do_uv = .true.
    endif
  endif
  !
  narg = sic_narg(0)
  do i = 1, 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')
      ! Modify velocity scale according to new rest frequency [MHz]
      call sic_r8(line,0,i+1,freq,.true.,error)
      do_freq = .true.
      !
    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
        call sic_ch(line,o_for,1,arg,nc,.true.,error)
        if (error) return
        !
        ! 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
        call gdf_setteles(desc%head,chain(1:nc),value,error)
      else
        !
        ! Update current UV and Initial UV data set if needed
        if (do_uv) then
          if (huv%gil%nteles.ge.1) then
            if (huv%gil%teles(1)%ctele .ne. chain(1:nc)) then
              call map_message(seve%i,rname,'Telescope ' &
              & //trim(huv%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%gil%teles(1)%ctele = ' '
              huvi%gil%teles(1)%ctele = ' '
            endif
          endif
          call gdf_addteles(huv,'TELE',chain(1:nc),value,error)
          call gdf_addteles(huvi,'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') 
      call sic_r4(line,0,i+1,bval,.true.,error)
      do_blank = .true.
      !
    case ('FREQUENCIES') 
      if (sic_narg(0).ne.2) then
        call map_message(seve%e,rname,'SPECIFY FREQUENCIES is exclusive of other actions')
        error =.true.
        return
      endif
      call sic_ke(line,0,i+1,arg,nc,.true.,error)
      if (error) return
      do_freqs = .true.
    end select
    if (error) return
  enddo
  !
  ! FREQUENCIES case
  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
      call sic_ch(line,o_for,1,arg,nc,.true.,error)
      if (error) return
      !
      if (index(arg,'.').ne.0) then
        ! It must be a file
        call gildas_null(hou,type='UVT')
        hou%file = arg
        !
        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,error)
      err = .false.
      call sic_mapgildas('UV',huv,err,duv)
      error = err.or.error
    endif
    return
  endif
  !
  if (do_one) then
    call sic_ch(line,o_for,1,arg,nc,.true.,error)
    if (error) return
    !
    ! 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
    freq = desc%head%gil%freq
    velo = desc%head%gil%voff
    cline = desc%head%char%line
    clines(icode_all) = desc%head%char%line
    freqs(icode_all) = freq
    velos(icode_all) = velo
  endif
  !
  ! Syntax check
  if (do_blank.and..not.do_one) then
    call map_message(seve%e,rname,'Option /FOR required for SPECIFY BLANKING')
    error = .true.
    return
  endif
  !
  ! Now which ones ...
  if (do_freq) freqs = freq
  if (do_velo) velos = velo
  if (do_line) clines = cline
  !
  if (do_one) then
    call gdf_modify(desc%head,velos(icode_all),freqs(icode_all),error=error)
    desc%head%char%line = clines(icode_all)
    if (do_blank) then
      call modify_blanking(desc,bval,error)
      if (error) return
    endif
  else 
    if (do_uv) then  !!  if (huv%loca%size.ne.0) then
      freq_b = gdf_uv_frequency(huv,1.d0)
      call gdf_modify(huv,velos(icode_uv),freqs(icode_uv),error=error)
      freq_a = gdf_uv_frequency(huv,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%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 com_modify
!
subroutine modify_blanking(desc,bval,error)
  use gkernel_types
  use gkernel_interfaces
  use gbl_message
  use iso_c_binding
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  ! 
  !   IMAGER
  !     Support routine for SPECIFY BLANKING
  !---------------------------------------------------------------------
  type(sic_descriptor_t), intent(inout) :: desc
  real, intent(in) :: bval
  logical, intent(out) :: error
  !
  type(c_ptr) :: cptr
  real(4), pointer :: rdata(:)
  integer(kind=index_length) :: i
  !
  if (desc%head%gil%eval.lt.0) return
  !
  if (desc%head%gil%form.eq.fmt_r4) then
    call adtoad(desc%addr,cptr,1)
    call c_f_pointer(cptr,rdata,[desc%size])
    !
    do i=1,desc%size
      if (abs(rdata(i)-desc%head%gil%bval).le.desc%head%gil%eval) rdata(i) = bval
    enddo
    desc%head%gil%bval = bval
    desc%head%gil%eval = 0.0 
  else
    call map_message(seve%e,'SPECIFY','Unsupported data format for BLANKING')
    error = .true.
    return
  endif
end subroutine modify_blanking
!
subroutine gdf_setfreqs(rname,desc,huv,error)
  use gkernel_types
  use gkernel_interfaces
  use imager_interfaces, only : map_message 
  use gbl_message
  use iso_c_binding
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER   Support for command
  !   SPECIFY FREQUENCIES Array [/FOR ImageVariable] 
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname
  type(sic_descriptor_t), intent(in) :: desc
  type(gildas), intent(inout) :: huv
  logical, intent(inout) :: error
  !
  integer :: stoke, new_nhb, ier
  type(c_ptr) :: cptr
  real(8), pointer :: dptr(:)
  !
  ! Verify match with number of channels of UV data
  if (desc%dims(1).ne.huv%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%gil%nstokes.eq.1) then
    if (associated(huv%gil%stokes)) stoke = huv%gil%stokes(1)
  else if (huv%gil%nstokes.ne.0) then
    call map_message(seve%e,rname,'FREQUENCIES only work for 1 Stokes')
    error = .true.
    return
  endif
  !
  if (huv%gil%nfreq.eq.0) then
    huv%gil%nfreq = desc%dims(1)
    allocate (huv%gil%freqs(huv%gil%nfreq),huv%gil%stokes(huv%gil%nfreq),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'FREQUENCIES allocation error')
      error = .true.
      return
    endif
    huv%gil%stokes = stoke
  endif
  !
  new_nhb = 2 + (3*huv%gil%nfreq + 2+10*huv%gil%nteles + 127)/128   ! Total number of HEADER blocks required...
  if (new_nhb.gt.huv%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%gil%nfreq])
  huv%gil%freqs(:) = dptr
  call gdf_setuv(huv,error)
  !
end subroutine gdf_setfreqs
!
subroutine gdf_setteles(head,chain,value,error)
  use image_def
  use imager_interfaces, only : map_message
  use gbl_message
  ! @ private
  type(gildas), intent(inout) :: head
  character(len=*), intent(in) :: chain
  real(8), intent(in) :: value(*)
  logical, intent(inout) :: error
  !
  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 data overwritten by SPECIFY TELESCOPE '//chain) 
      endif
      ! Undefine the telescope so that all characteristics
      ! are re-defined by gdf_addteles after
      head%gil%teles(1)%ctele = ' '
    endif
  endif
  call gdf_addteles(head,'TELE',chain,value,error)
end subroutine gdf_setteles
