!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module mapping_read
  use gbl_message
  !
  public :: read_comm
  public :: out_range,check_uvdata_type,mosaic_getfields
  private
  !
contains
  !
  subroutine read_comm(line,error)
    use gkernel_interfaces
    use clean_arrays
    use buffer_types
    !----------------------------------------------------------------------
    ! READ Type File
    !   [/COMPACT]
    !   [/NOTRAIL]
    !   [/RANGE Start End Type]
    !   [/FREQUENCY RestFreqMHz]
    !   [/PLANE] (obsolete)
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: ntype,nn,ikey
    character(len=12) :: argu,atype
    character(len=filename_length) :: name
    logical :: compact,lexist,do_freq
    character(len=filename_length) :: file
    real(kind=8) :: dovrange(2), freq
    character(len=12) :: docrange,crange
    !
    integer(kind=4), parameter :: o_compact=1
    integer(kind=4), parameter :: o_freq=2
    integer(kind=4), parameter :: o_plane=3
    integer(kind=4), parameter :: o_range=4
    integer(kind=4), parameter :: o_trail=5
    integer(kind=4), parameter :: mranges=3
    character(len=12), parameter :: ranges(mranges)= (/'CHANNEL  ','VELOCITY ','FREQUENCY'/)
    !
    call sic_ke (line,0,1,argu,nn,.true.,error)
    if (error) return
    call sic_ch (line,0,2,name,nn,.true.,error)
    if (error) return
    !
    ! Default settings
    dovrange(:) = 0.d0
    docrange = 'NONE'
    !
    ! /PLANE (for compatibility)
    if (sic_present(o_plane,0)) then
       call sic_r8 (line,o_plane,1,dovrange(1),.true.,error)
       if (error) return
       call sic_r8 (line,o_plane,2,dovrange(2),.true.,error)
       if (error) return
       docrange = 'CHANNEL'
    endif
    !
    ! /RANGE (for flexibility)
    if (sic_present(o_range,0)) then
       call sic_r8 (line,o_range,1,dovrange(1),.true.,error)
       if (error) return
       call sic_r8 (line,o_range,2,dovrange(2),.true.,error)
       if (error) return
       call sic_ke (line,o_range,3,argu,nn,.true.,error)
       if (error) return
       call sic_ambigs('READ',argu,docrange,ikey,ranges,mranges,error)
       if (error)  return
    endif
    !
    ! /FREQUENCY Option
    do_freq = sic_present(o_freq,0)
    if (do_freq) then
       call sic_r8(line,o_freq,1,freq,.true.,error)
       if (error) return
    endif
    !
    ! /COMPACT
    compact = sic_present(o_compact,0)
    !
    if (argu.eq.'*') then
       !
       ! Find all files of relevant extension, and load them
       do ntype=1,mtype_read
          lexist = sic_findfile(name,file,' ',etype(ntype))
          if (lexist) then
             call map_message(seve%i,'READ','Loading '//vtype(ntype)//trim(file))
             if (ntype.eq.1 .or. ntype.eq.mtype) then
                ! Unclear which buffers do not support a range...
                crange = 'NONE'
             else
                crange = docrange
             endif
             if (do_freq) then
                call read_main(name,ntype,dovrange,crange,compact,error,freq)
             else
                call read_main(name,ntype,dovrange,crange,compact,error)
             endif
          endif
       enddo
    else
       call sic_ambigs ('READ',argu,atype,ntype,vtype,mtype_read,error)
       if (error) return
       !
       if (do_freq) then
          call read_main(name,ntype,dovrange,docrange,compact,error,freq)
       else
          call read_main(name,ntype,dovrange,docrange,compact,error)
       endif
    endif
  end subroutine read_comm
  !
  subroutine read_main(name,ntype,dovrange,crange,compact,error,freq)
    use gkernel_interfaces
    use clean_arrays
    use buffer_types
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    character(len=*),  intent(in)    :: name
    integer,           intent(in)    :: ntype       ! Type of data
    real(8),           intent(in)    :: dovrange(2) ! Range to be read
    character(len=*),  intent(in)    :: crange      ! Type of range
    logical,           intent(in)    :: compact     ! ACA buffer flag
    logical,           intent(inout) :: error
    real(8), optional, intent(in)    :: freq        ! Desired rest frequency
    !
    type (gildas) :: head
    integer :: nc(2)
    logical :: nochange, attempt, myerror
    real(4) :: velo
    !
    call gildas_null(head)
    call sic_parse_file(name,' ',etype(ntype),head%file)
    !
    head%blc = 0
    head%trc = 0
    !
    ! Read Header
    call gdf_read_header (head,error)
    if (error) return
    !
    ! Shift it to the requested Rest Frequency if needed
    if (present(freq)) then
       velo = head%gil%voff
       call gdf_modify(head,velo,freq,error=error)
       if (error) return
    endif
    !
    call out_range('READ',crange,dovrange,nc,head,error)
    if (error) return
    !
    ! Check if anything changed
    if (.not.compact) then
       ! We must check if the corresponding buffer is still allocated !...
       select case(vtype(ntype))
       case ('CCT')
          attempt = hcct%loca%size.ne.0
       case ('RESIDUAL')
          attempt = hresid%loca%size.ne.0
       case ('CLEAN')
          attempt = hclean%loca%size.ne.0
       case default
          attempt = .true.
       end select
       if (attempt) then
          call reread(ntype,head%file,optimize(ntype),nc,nochange)
          if (nochange) return
       endif
    endif
    !
    ! Read Data as required
    call map_read(head,vtype(ntype),nc,compact,error)
    if (error)  goto 100
    !
    ! Indicate Buffer will has been read
    optimize(ntype)%change = 0
    !
100 continue
    ! Free image slot 
    myerror = .false.
    call gdf_close_image(head,myerror)
    error = error.or.myerror
  end subroutine read_main
  !
  subroutine reread(atype,file,opti,nc,nochange)
    use gkernel_interfaces
    use uv_buffer_tool
    use buffer_types
    use clean_arrays
    !---------------------------------------------------------------------
    ! Check if the file of type "atype" needs to be read again.
    !---------------------------------------------------------------------
    integer,          intent(in)    :: atype    ! Code of type of file
    character(len=*), intent(in)    :: file     ! Filename
    type(readop_t),   intent(inout) :: opti     ! Status of corresponding buffer
    integer,          intent(in)    :: nc(2)    ! Range to be read
    logical,          intent(out)   :: nochange ! Change status
    !
    logical :: error
    integer :: msev
    character(len=36) :: mess,trail
    !
    nochange = .false.           ! By default
    !
    opti%modif%modif = .true.    ! In case of error
    call gag_filmodif(file,opti%modif,error)
    if (.not.opti%modif%modif) then
       if (nc(1).eq.opti%lastnc(1) .and. nc(2).eq.opti%lastnc(2)) then
          mess = 'File not modified and same range  -- '
          msev = seve%w
          nochange = .true.
       else
          mess = 'File not modified, different range - '
          msev = seve%i
       endif
    else
       opti%lastnc = nc
       return
    endif
    opti%lastnc = nc
    !
    ! The buffers may however have been manipulated in Mapping
    if (optimize(atype)%change.gt.1) then
       nochange = .false.
       trail = ' Buffer changed -- Reloaded '
       msev = seve%i
    else if (optimize(atype)%change.eq.1 .and. nochange) then
       ! Is there a buffer to be Reset
       if (atype.eq.code_save_uv) then
          call uv_reset_buffer('READ')
          call sic_delvariable ('UV',.false.,error)
          call sic_mapgildas('UV',huv,error,duvi)
       endif
       optimize(atype)%change = 0
       trail = ' Reset from Buffer'
    else if (nochange) then
       trail = ' not reloaded '
    else
       trail = ' reloaded '
    endif
    !
    call map_message(msev,'READ',mess//trail)
    ! No Read / Write optimization
    ! RW_Optimize is an integer, so that we may distinguish
    ! optimization based on "atype"
    if (rw_optimize.eq.0 .and. nochange) then
       call map_message(seve%w,'READ','Reading enforced by user')
       nochange = .false.
    endif
  end subroutine reread
  !
  subroutine map_read(head,out,nc,compact,error)
    use gkernel_interfaces
    use uv_buffer_tool
    use clean_arrays
    use buffer_types
    use mapping_default_types
    use mapping_mosaic
    !----------------------------------------------------------------------
    ! Read some type of input data.
    !------------------------------------------------------------------
    type (gildas),    intent(inout) :: head    ! Header of data
    character(len=*), intent(in)    :: out     ! Desired data
    integer,          intent(in)    :: nc(2)   ! Channel range
    logical,          intent(in)    :: compact ! Put in ACA space ?
    logical,          intent(inout) :: error
    !
    type (gildas) :: htmp
    logical :: subset
    integer :: i,ier,nchan,local_nc(2)
    integer, parameter :: o_trail=5
    character(len=message_length) chain
    character(len=*), parameter :: rname='READ'
    !
    error = .false.
    !
    if (.not.compact) then
       select case (out)
       case ('BEAM')
          ! Beam is a 4-D array of dimension Nx Ny Np Nb
          ! where Nb is the number of "beam frequencies"
          ! and Np the number of pointing centers
          call gdf_copy_header(head, hbeam, error)
          hbeam%loca = head%loca
          save_data(code_save_beam) = .false.
          call sic_delvariable ('BEAM',.false.,error)
          if (allocated(dbeam)) deallocate(dbeam,stat=ier)
          hbeam%gil%dim(3) = max(1,hbeam%gil%dim(3))
          hbeam%gil%dim(4) = max(1,hbeam%gil%dim(4))
          allocate(dbeam(hbeam%gil%dim(1),hbeam%gil%dim(2),   &
               &        hbeam%gil%dim(3),hbeam%gil%dim(4)),stat=ier)
          call gdf_read_data(hbeam,dbeam,error)
          if (error) return
          !
          ! One should check here the beam order:
          ! input beams can also be
          !   Nx Ny Nb
          ! or
          !   NX Ny Np
          ! depending on GILDAS  version used for creation
          call sic_mapgildas('BEAM',hbeam,error,dbeam)
          ! Special case for UV data
       case ('UV')
          ! Free the previous zone
          call uv_free_buffers
          save_data(code_save_uv) = .false.
          !
          call gildas_null (huv, type= 'UVT')
          call gildas_null (htmp, type= 'UVT')
          call gdf_copy_header(head, htmp, error)
          ! Check appropriate order
          if (htmp%char%code(1).eq."RANDOM") then
             call map_message(seve%w,rname,'UV data is transposed')
             call gdf_transpose_header (htmp, huv, '21', error)
             subset = .true.
          else
             call gdf_copy_header(htmp, huv, error)
             subset = .false.
          endif
          if (error)  return
          htmp%loca = head%loca
          huv%loca = head%loca   ! Why : to get the image slot !...
          !
          uv_plotted = .false.
          call sic_delvariable ('UV',.false.,error)
          call sic_delvariable ('UVS',.false.,error)
          !
          ! Extract desired channels
          nchan = huv%gil%nchan
          local_nc = nc
          ier = gdf_range (local_nc, nchan)
          nchan = local_nc(2)-local_nc(1)+1
          huv%gil%ref(1) = huv%gil%ref(1)-local_nc(1)+1
          huv%gil%dim(1) = huv%gil%nlead+huv%gil%natom*huv%gil%nstokes*nchan
          if (huv%gil%ntrail.gt.0) then
             if (sic_present(o_trail,0)) then    ! /NOTRAIL option
                do i=1,code_uvt_last
                   if (huv%gil%column_pointer(i).gt.huv%gil%dim(1)) then
                      call map_message(seve%w,rname,'Found column '//uv_column_name(i))
                      huv%gil%column_size(i) = 0
                      huv%gil%column_pointer(i) = 0
                   endif
                enddo
                huv%gil%ntrail = 0
             endif
             ! use them according to user selection
             huv%gil%dim(1) = huv%gil%dim(1) + huv%gil%ntrail
          endif
          huv%gil%nchan = nchan
          allocate(duvi(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
          if (failed_allocate(rname,'UV data buffer',ier,error))  return
          call gdf_read_uvdataset(htmp,huv,local_nc,duvi,error)
          if (gildas_error(huv,rname,error)) return
          !
          ! Nullify Beyond NVISI in case of incomplete data set
          if (huv%gil%nvisi.lt.huv%gil%dim(2)) then
             duvi(:,huv%gil%nvisi+1:huv%gil%dim(2)) = 0.
          endif
          !
          duv => duvi              ! Point on original data
          duvr => duvi             ! Point on original data
          !
          ! Check the type and number of fields
          call check_uvdata_type(huv,duv,themap,error)
          if (error) return
          !!print *,'Defining UV'
          call sic_mapgildas('UV',huv,error,duvi)
          !!print *,'Copying header'
          call gildas_null (huvi, type = 'UVT')
          call gdf_copy_header(huv,huvi, error)
          !
          do_weig = .true.
          !
          ! Unload the PRIMARY array if defined
          call sic_delvariable ('PRIMARY',.false.,error)
          if (allocated(dprim)) deallocate(dprim,stat=ier)
          hprim%loca%size = 0
       case ('MODEL')
          ! Free the previous zone
          call sic_delvariable ('UVM',.false.,error)
          if (allocated(duvm)) then
             deallocate(duvm,stat=ier)
          endif
          !
          call gildas_null (huvm, type= 'UVT')
          call gildas_null (htmp, type= 'UVT')
          call gdf_copy_header(head, htmp, error)
          ! Check appropriate order
          if (htmp%char%code(1).eq."RANDOM") then
             call map_message(seve%w,rname,'UV data is transposed')
             call gdf_transpose_header (htmp, huvm, '21', error)
          else
             call gdf_copy_header(htmp, huvm, error)
          endif
          if (error)  return
          htmp%loca = head%loca
          huvm%loca = head%loca   ! Why ? See above !
          !
          ! Extract desired channels
          nchan = huvm%gil%nchan
          local_nc = nc
          ier = gdf_range (local_nc, nchan)
          nchan = local_nc(2)-local_nc(1)+1
          huvm%gil%ref(1) = huvm%gil%ref(1)-local_nc(1)+1
          huvm%gil%dim(1) = huvm%gil%nlead+huvm%gil%natom*nchan
          if (huvm%gil%ntrail.gt.0) then
             if (sic_present(o_trail,0)) then    ! /NOTRAIL option
                do i=1,code_uvt_last
                   if (huvm%gil%column_pointer(i).gt.huvm%gil%dim(1)) then
                      call map_message(seve%w,rname,'Found column '//uv_column_name(i))
                      huvm%gil%column_size(i) = 0
                      huvm%gil%column_pointer(i) = 0
                   endif
                enddo
                huvm%gil%ntrail = 0
             endif
             ! use them according to user selection
             huvm%gil%dim(1) = huvm%gil%dim(1) + huvm%gil%ntrail
          endif
          huvm%gil%nchan = nchan
          allocate(duvm(huvm%gil%dim(1),huvm%gil%dim(2)),stat=ier)
          call gdf_read_uvdataset(htmp,huvm,local_nc,duvm,error)
          if (gildas_error(huvm,rname,error)) return
          !
          huvm%loca%size = huvm%gil%dim(1)*huvm%gil%dim(2)
          call sic_def_real('UVM',duvm,huvm%gil%ndim,&
               huvm%gil%dim,.true.,error)
       case ('DIRTY')
          save_data(code_save_dirty) = .false.
          call sic_delvariable ('DIRTY',.false.,error)
          if (allocated(ddirty)) deallocate(ddirty,stat=ier)
          !
          ! Specify the subset
          error = map_range(nc,head,hdirty)
          if (error) return
          !
          allocate(ddirty(hdirty%gil%dim(1),hdirty%gil%dim(2),   &
               &        hdirty%gil%dim(3)),stat=ier)
          call gdf_read_data(head,ddirty,error)
          if (error) return
          !
          call sic_mapgildas('DIRTY',hdirty,error,ddirty)
          user_method%do_mask = .true.
          !
          ! Define Min Max
          d_max = hdirty%gil%rmax
          if (hdirty%gil%rmin.eq.0) then
             d_min = -0.03*hdirty%gil%rmax
          else
             d_min = hdirty%gil%rmin
          endif
       case ('RESIDUAL')
          save_data(code_save_resid) = .false.
          call sic_delvariable ('RESIDUAL',.false.,error)
          if (allocated(dresid)) deallocate(dresid,stat=ier)
          ! Specify the subset
          error = map_range(nc,head,hresid)
          if (error) return
          allocate(dresid(hresid%gil%dim(1),hresid%gil%dim(2),   &
               &        hresid%gil%dim(3)),stat=ier)
          call gdf_read_data(head,dresid,error)
          if (error) return
          call sic_mapgildas('RESIDUAL',hresid,error,dresid)
          user_method%do_mask = .true.
       case ('CLEAN')
          save_data(code_save_clean) = .false.
          call sic_delvariable ('CLEAN',.false.,error)
          if (allocated(dclean)) deallocate(dclean,stat=ier)
          ! Specify the subset
          error = map_range(nc,head,hclean)
          if (error) return
          allocate(dclean(hclean%gil%dim(1),hclean%gil%dim(2),   &
               &        hclean%gil%dim(3)),stat=ier)
          call gdf_read_data(head,dclean,error)
          if (error) return
          call sic_mapgildas ('CLEAN',hclean,error,dclean)
       case ('MASK')
          save_data(code_save_mask) = .false.
          call sic_delvariable ('MASK',.false.,error)
          if (allocated(dmask)) deallocate(dmask,stat=ier)
          ! Specify the subset
          error = map_range(nc,head,hmask)
          if (error) return
          allocate(dmask(hmask%gil%dim(1),hmask%gil%dim(2),hmask%gil%dim(3)),   &
               &        stat=ier)
          call gdf_read_data(head,dmask,error) 
          if (error) return
          call sic_mapgildas ('MASK',hmask,error,dmask)
          user_method%do_mask = .true.
       case ('PRIMARY')
          ! Primary is a 4-D array of dimension Np Nx Ny Nb
          ! where Nb is the number of "beam frequencies"
          ! and Np the number of pointing centers
          !
          ! /RANGE option not effective here
          !
          call gdf_copy_header(head, hprim, error)
          hprim%loca = head%loca
          save_data(code_save_primary) = .false.
          call sic_delvariable ('PRIMARY',.false.,error)
          if (allocated(dprim)) deallocate(dprim,stat=ier)
          hprim%gil%dim(4) = max(1,hprim%gil%dim(4))
          allocate(dprim(hprim%gil%dim(1),hprim%gil%dim(2),   &
               &        hprim%gil%dim(3),hprim%gil%dim(4)),stat=ier)
          call gdf_read_data(hprim,dprim,error)
          if (error) return
          call sic_mapgildas('PRIMARY',hprim,error,dprim)
          !
          ! Old GILDAS primary beams had only one Frequency channel
          !
          ! Switch to mosaic mode
          user_method%trunca = hprim%gil%inc(1)  ! Truncation of beam
          user_method%search = user_method%trunca
          user_method%restor = user_method%trunca
          call map_message(seve%i,rname,'Primary Beam read, setting MOSAIC')
          call mosaic_main('ON',error)
          if (error) return
       case ('CCT')
          call gdf_copy_header(head, hcct, error)
          hcct%loca = head%loca
          save_data(code_save_cct) = .false.
          call sic_delvariable ('CCT',.false.,error)
          if (allocated(dcct)) deallocate(dcct,stat=ier)
          ! Specify the subset
          call map_message(seve%w,rname,'CCT -- range ignored')
          !      error = map_range(nc,head,hcct)
          !      if (error) return
          head%blc = 0
          head%trc = 0
          allocate(dcct(hcct%gil%dim(1),hcct%gil%dim(2),   &
               &        hcct%gil%dim(3)),stat=ier)
          call gdf_read_data(head,dcct,error)
          if (error) return
          call sic_mapgildas ('CCT',hcct,error,dcct)
       case default
          chain = 'Unsupported operation '//out
          call map_message(seve%e,rname,chain)
          error = .true.
       end select
    else
       ! Compact Array data
       ! 4-D not yet done...
       !
       select case (out)
       case ('BEAM')
          call gdf_copy_header(head, c_hbeam, error)
          c_hbeam%loca = head%loca
          save_data(code_save_beam) = .false.
          call sic_delvariable ('C_BEAM',.false.,error)
          if (allocated(c_dbeam)) deallocate(c_dbeam,stat=ier)
          allocate(c_dbeam(c_hbeam%gil%dim(1),c_hbeam%gil%dim(2),   &
               &        c_hbeam%gil%dim(3)),stat=ier)
          call gdf_read_data(c_hbeam,c_dbeam,error)
          if (error) return
          c_hbeam%gil%dim(3) = max(1,c_hbeam%gil%dim(3))
          call sic_def_real ('C_BEAM',c_dbeam,c_hbeam%gil%ndim,   &
               &        c_hbeam%gil%dim,.true.,error)
       case ('DIRTY')
          call gdf_copy_header(head, c_hdirty, error)
          c_hdirty%loca = head%loca
          save_data(code_save_dirty) = .false.
          call sic_delvariable ('C_DIRTY',.false.,error)
          if (allocated(c_ddirty)) deallocate(c_ddirty,stat=ier)
          allocate(c_ddirty(c_hdirty%gil%dim(1),c_hdirty%gil%dim(2),   &
               &        c_hdirty%gil%dim(3)),stat=ier)
          call gdf_read_data(c_hdirty,c_ddirty,error)
          if (error) return
          call sic_def_real ('C_DIRTY',c_ddirty,c_hdirty%gil%ndim,   &
               &        c_hdirty%gil%dim,.true.,error)
          cuse_method%do_mask = .true.
       case ('RESIDUAL')
          call gdf_copy_header(head, c_hresid, error)
          c_hresid%loca = head%loca
          save_data(code_save_resid) = .false.
          call sic_delvariable ('C_RESIDUAL',.false.,error)
          if (allocated(c_dresid)) deallocate(c_dresid,stat=ier)
          allocate(c_dresid(c_hresid%gil%dim(1),c_hresid%gil%dim(2),   &
               &        c_hresid%gil%dim(3)),stat=ier)
          call gdf_read_data(c_hresid,c_dresid,error)
          if (error) return
          call sic_def_real ('C_RESIDUAL',c_dresid,c_hresid%gil%ndim,   &
               &        c_hresid%gil%dim,.true.,error)
          cuse_method%do_mask = .true.
          !
       case ('PRIMARY')
          call gdf_copy_header(head, c_hprim, error)
          c_hprim%loca = head%loca
          call sic_delvariable ('C_PRIMARY',.false.,error)
          if (allocated(c_dprim)) deallocate(c_dprim,stat=ier)
          allocate(c_dprim(c_hprim%gil%dim(1),c_hprim%gil%dim(2),   &
               &        c_hprim%gil%dim(3)),stat=ier)
          call gdf_read_data(c_hprim,c_dprim,error)
          if (error) return
          call sic_def_real ('C_PRIMARY',c_dprim,c_hprim%gil%ndim,   &
               &        c_hprim%gil%dim,.true.,error)
          !
          ! Switch to mosaic mode
          cuse_method%trunca = c_hprim%gil%inc(1)  ! Truncation of beam
          cuse_method%search = cuse_method%trunca
          cuse_method%mosaic = .true.
       case default
          chain = 'Unsupported operation '//out
          call map_message(seve%e,rname,chain)
          error = .true.
       end select
    endif
  end subroutine map_read
  !
  function map_range(nc,hin,hou)
    use gkernel_interfaces, only: gdf_range
    use image_def
    !---------------------------------------------------------------------
    ! Define channel range and set output Map header accordingly
    !---------------------------------------------------------------------
    integer,       intent(in)    :: nc(2)     ! Input channel range
    type (gildas), intent(inout) :: hin       ! Input header
    type (gildas), intent(inout) :: hou       ! Output header
    logical                      :: map_range ! intent(out)
    !
    integer local_nc(2), hdim, faxi
    !
    ! Copy header
    call gdf_copy_header(hin, hou, map_range)
    if (map_range) return
    hou%loca = hin%loca
    !
    ! Find out the actual range
    faxi = hin%gil%faxi
    local_nc = nc
    map_range = gdf_range(local_nc,hin%gil%dim(faxi)).ne.0
    if (map_range) return
    hdim = local_nc(2) - local_nc(1) + 1
    !
    ! Set the input header subset range
    hin%blc(faxi) = local_nc(1)
    hin%trc(faxi) = local_nc(2)
    !
    ! Set the output header reference channel and number of channels
    hou%gil%ref(faxi) = hou%gil%ref(faxi)+1-max(hin%blc(faxi),1)
    hou%gil%dim(faxi) = hdim
    !
    ! Correct the data size
    hou%loca%size = hin%loca%size*hou%gil%dim(faxi)/hin%gil%dim(faxi)
  end function map_range
  !
  subroutine out_range(rname,atype,dovrange,nc,head,error)
    use image_def
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Utility routine to define a channel range from a Velocity, Frequency
    ! or Channel range
    !---------------------------------------------------------------------
    character(len=*), intent(in)  :: rname        ! Caller name
    character(len=*), intent(in)  :: atype        ! Type of range
    real(kind=8),     intent(in)  :: dovrange(2)  ! Input range
    integer(kind=4),  intent(out) :: nc(2)        ! Ouput channel number
    type(gildas),     intent(in)  :: head         ! Reference GILDAS data frame
    logical,          intent(out) :: error        ! Error flag
    !
    real(8) :: frange(2)
    integer :: itype, nn, ier, nchan
    integer(kind=4), parameter :: mtype=4
    character(len=12) :: types(mtype),mytype,ctype
    data types /'CHANNEL','VELOCITY','FREQUENCY','NONE'/
    character(len=message_length) :: chain
    !
    ctype = atype
    call sic_upper(ctype)
    error = .false.
    call sic_ambigs(rname,ctype,mytype,itype,types,mtype,error)
    if (error)  return
    !
    if (abs(head%gil%type_gdf).eq.code_gdf_uvt) then
       nchan = head%gil%nchan
    else if (head%gil%faxi.ne.0) then
       nchan = head%gil%dim(head%gil%faxi)
    else if (head%gil%ndim.eq.2) then
       call map_message(seve%w,rname,'Dataset is 2-D only') 
       nchan = 1
    else  
       if (mytype.ne.'NONE') call map_message(seve%w,rname, &
            & 'No Frequency axis, /RANGE option ignored.')
       nc = 1
       return
    endif
    !
    if (mytype.eq.'CHANNEL') then
       nc = nint(dovrange)
    else if (mytype.eq.'VELOCITY') then
       if ( abs(head%gil%type_gdf).eq.abs(code_gdf_uvt) ) then
          ! UV data case
          frange = (dovrange - head%gil%voff) / head%gil%vres + head%gil%ref(head%gil%faxi)
       else if  (head%gil%faxi.eq.0) then  !
          call map_message(seve%e,rname,'No Velocity/Frequency Axis')
          error = .true.
          return
       else if (head%char%code(head%gil%faxi).eq.'FREQUENCY') then
          frange = -(dovrange-head%gil%voff)*head%gil%freq/299792.458d0+head%gil%freq
          frange = (frange - head%gil%val(head%gil%faxi)) / head%gil%fres + head%gil%ref(head%gil%faxi)
       else if (head%char%code(head%gil%faxi).eq.'VELOCITY') then
          frange = (dovrange - head%gil%voff) / head%gil%vres + head%gil%ref(head%gil%faxi)
       else
          call map_message(seve%e,rname,'Axis type '//head%char%code(head%gil%faxi)//' not supported')
          error = .true.
          return
       endif
       !
       nc = nint(frange)
       if (nc(1).gt.nc(2)) then
          nn = nc(2)
          nc(2) = nc(1)
          nc(1) = nn
       endif
       if (nc(1).gt.nchan .or. nc(2).lt.1) then
          write(chain,'(A,I8,A,I8,A,I8,A)') 'Range [',nc(1),',',nc(2),'] out of bounds [1,',nchan,']'
          call map_message(seve%e,rname,chain)
          error = .true.
          return
       endif
       nc = max(1,min(nc,nchan))
    else if (mytype.eq.'FREQUENCY') then
       ! The current code is only valid for UV Tables.
       ! See as above for the VELOCITY case
       ! dovrange = nc - head%gil%ref(head%gil%faxi) ) * head%gil%vres + head%gil%voff
       if ( abs(head%gil%type_gdf).eq.abs(code_gdf_uvt) ) then
          ! UV data case is always the same...
          frange = (dovrange - head%gil%freq) / head%gil%fres + head%gil%ref(head%gil%faxi)
       else if (head%gil%faxi.eq.0) then  !
          call map_message(seve%e,rname,'No Velocity/Frequency Axis')
          error = .true.
          return
       else if (head%char%code(head%gil%faxi).eq.'FREQUENCY') then
          frange = (dovrange - head%gil%val(head%gil%faxi)) / head%gil%fres + head%gil%ref(head%gil%faxi)
       else if (head%char%code(head%gil%faxi).eq.'VELOCITY') then
          frange = -(dovrange-head%gil%freq)/head%gil%freq*299792.458d0 + head%gil%voff
          frange = (frange - head%gil%val(head%gil%faxi)) / head%gil%vres + head%gil%ref(head%gil%faxi)
       else
          call map_message(seve%e,rname,'Axis type '//head%char%code(head%gil%faxi)//' not supported')
          error = .true.
          return
       endif
       !
       nc = nint(frange)
       if (nc(1).gt.nc(2)) then
          nn = nc(2)
          nc(2) = nc(1)
          nc(1) = nn
       endif
       if (nc(1).gt.nchan .or. nc(2).lt.1) then
          write(chain,'(A,I8,A,I8,A,I8,A)') 'Range [',nc(1),',',nc(2),'] out of bounds [1,',nchan,']'
          call map_message(seve%e,rname,chain)
          error = .true.
          return
       endif
       nc = max(1,min(nc,nchan))
    else if (mytype.eq.'NONE') then
       nc = [1,nchan]
    else
       call map_message(seve%f,rname,'Type of value '''//trim(mytype)//''' not supported')
       error = .true.
       return
    endif
    !
    ier = gdf_range (nc, nchan)
    if (ier.ne.0) error = .true.
  end subroutine out_range
  !
  subroutine check_uvdata_type(huv,duv,map,error)
    use image_def
    use gkernel_interfaces
    use uvmap_types
    use mapping_primary, only: get_bsize
    !-------------------------------------------------------
    ! Check number and types of fields
    !-------------------------------------------------------
    type(gildas),    intent(inout) :: huv
    real,            intent(inout) :: duv(:,:)
    type(uvmap_par), intent(inout) :: map
    logical,         intent(inout) :: error
    !
    integer :: np, nv
    integer :: loff, moff, xoff, yoff, nf, lid
    character(len=12) :: chain
    integer(kind=index_length) :: dim(2)
    real, save, target :: bsize
    real :: value
    logical, parameter :: fromressection=.true.
    !
    map%nfields = 0
    call sic_delvariable('FIELDS',.false.,error)
    error = .false.
    huv%loca%size = huv%gil%dim(1)*huv%gil%dim(2)    ! So that UV is known later
    if (huv%gil%ntrail.eq.0) return
    !
    np = huv%gil%dim(1)
    nv = huv%gil%nvisi
    !
    loff = huv%gil%column_pointer(code_uvt_loff)
    moff = huv%gil%column_pointer(code_uvt_moff)
    !
    xoff = huv%gil%column_pointer(code_uvt_xoff)
    yoff = huv%gil%column_pointer(code_uvt_yoff)
    !
    lid  = huv%gil%column_pointer(code_uvt_id)
    !
    if (lid.ne.0 .and. (loff.eq.0.or.moff.eq.0)) then
       value = duv(lid,1)
       if (any(duv(lid,:).ne.value)) then 
          nf = maxval(duv(lid,:))
          write(chain,'(I12)') nf
          call map_message(seve%e,'READ','Mosaic of '//adjustl(trim(chain))//' fields with only Source ID column')
          call map_message(seve%i,'READ','Use task UV_UPDATE_FIELDS to specify field coordinates')
          huv%loca%size = 0        ! UV undefined at this stage
          error = .true.
          return
       else
          map%nfields = 0
          call map_message(seve%w,'READ','Degenerate mosaic of 1 field with Source ID column')
       endif
    else if (loff.ne.0 .or. moff.ne.0) then
       call mosaic_getfields (duv,np,nv,loff,moff,nf,map%offxy)
       if (nf.gt.1) then
          map%nfields = -nf
          write(chain,'(I12)') nf
          call map_message(seve%i,'READ','Raw mosaic of '//adjustl(trim(chain))//' fields')
       else
          map%nfields = 0
          call map_message(seve%w,'READ','Degenerate raw mosaic of 1 field')
       endif
    else if (xoff.ne.0 .or. yoff.ne.0) then
       call mosaic_getfields (duv,np,nv,xoff,yoff,nf,map%offxy)
       if (nf.gt.1) then
          map%nfields = nf
          write(chain,'(I12)') nf
          call map_message(seve%i,'READ','Phase shifted mosaic of '//adjustl(trim(chain))//' fields')
       else
          map%nfields = 0
          call map_message(seve%w,'READ','Degenerate phase shifted mosaic of 1 field')
       endif
    endif
    !
    if (map%nfields.eq.0) return
    !
    if (huv%gil%nteles.le.0) then
       call map_message(seve%w,'READ','No Telescope section in data') 
       call map_message(seve%r,'READ', &
            &   '         Use command "SPECIFY TELESCOPE Name" to add one') 
    endif
    !  
    call get_bsize(huv,'READ',' ',fromressection,bsize,error)
    call sic_defstructure('FIELDS',.true.,error)
    call sic_def_inte('FIELDS%N',map%nfields,0,dim,.false.,error)
    dim(1:2) = [2,abs(map%nfields)]
    call sic_def_real('FIELDS%OFFSETS',map%offxy,2,dim,.false.,error) 
    call sic_def_real('FIELDS%PRIMARY',bsize,0,dim,.false.,error)
  end subroutine check_uvdata_type
  !
  subroutine mosaic_getfields(visi,np,nv,ixoff,iyoff,nf,doff)
    !----------------------------------------------------------------------
    ! Count number of fields and Get their coordinates
    !----------------------------------------------------------------------
    integer,           intent(in)    :: np           ! Size of a visibility
    integer,           intent(in)    :: nv           ! Number of visibilities
    real,              intent(inout) :: visi(np,nv)  ! Input visibilities
    integer,           intent(in)    :: ixoff        ! X pointer
    integer,           intent(in)    :: iyoff        ! Y pointer
    integer,           intent(out)   :: nf           ! Number of fields
    real, allocatable, intent(out)   :: doff(:,:)    ! Field offsets
    !
    integer :: iv,mfi,nfi,kfi,ifi,ier
    real(kind=4), allocatable :: dtmp(:,:)
    real(kind=4) :: off_tol
    !
    if (nv.le.0) then
       nf = 0
       return
    endif
    !
    ! Scan how many fields
    !
    off_tol = 1E-2*acos(-1.0)/180.0/3600.0       ! 0.01 sec is enough
    nfi = 1
    mfi = 100
    !
    allocate(dtmp(2,mfi),stat=ier)
    dtmp(1,1) = visi(ixoff,1)
    dtmp(2,1) = visi(iyoff,1)
    nfi = 1
    !
    ! Fields are not ordered here
    do iv=2,nv
       kfi = 0
       do ifi=1,nfi
          if (abs(visi(ixoff,iv)-dtmp(1,ifi)).le.off_tol .and. &
               abs(visi(iyoff,iv)-dtmp(2,ifi)).le.off_tol ) then
             visi(ixoff,iv) = dtmp(1,ifi)
             visi(iyoff,iv) = dtmp(2,ifi)
             kfi = ifi
             exit
          endif
       enddo
       !
       ! New field
       if (kfi.eq.0) then
          if (nfi.eq.mfi) then
             allocate(doff(2,mfi),stat=ier)
             doff(:,:) = dtmp(:,:)
             deallocate(dtmp)
             allocate(dtmp(2,2*mfi),stat=ier)
             dtmp(:,1:mfi) = doff
             deallocate(doff)
             mfi = 2*mfi
          endif
          nfi = nfi+1
          dtmp(1,nfi) = visi(ixoff,iv)
          dtmp(2,nfi) = visi(iyoff,iv)
       endif
    enddo
    !
    nf = nfi
    allocate(doff(2,nf),stat=ier)
    doff(:,:) = dtmp(1:2,1:nf)
  end subroutine mosaic_getfields
end module mapping_read
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
