subroutine clic_get(line,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_title
  use clic_index
  use clic_rdata
  !---------------------------------------------------------------------
  ! SAS	Support routine for command
  !	GET Number [Version] /DUMP idump
  !	    NEXT
  !	    FIRST
  ! Arguments :
  !	LINE	C*(*)	Command line
  !	ERROR	L	Logical error flag
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  include 'clic_virtual.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: end
  integer(kind=entry_length)   :: kx, nnn
  integer(kind=data_length)    :: h_offset, c_offset, l_offset
  integer(kind=data_length)    :: ldata_in
  integer(kind=address_length) :: data_in, kin, ipk
  integer :: mmm, idump, n, k, ib, isb, nch, ir
  character(len=12) :: argum
  character(len=100) :: nombre
  !------------------------------------------------------------------------
  ! Code:
  !
  ! Verify if any input file
  call check_input_file(error)
  if (error) return
  !
  ! Locate the observation to get
  argum=' '
  call sic_ke(line,0,1,argum,nch,.false.,error)
  if (error) return
  if (argum(1:1).eq.'F') then
    call check_index(error)
    if (error) return
    call get_first(.true.,error)
    if (error) return
    goto 30
  elseif (argum(1:1).eq.'N') then
    end = .false.
    call get_next(end,error)
    if (error) return
    if (end) then
      call message(6,3,'CLIC_GET',   &
        'End of current index encountered')
      error = .true.
      return
    endif
    goto 30
  endif
  if (sic_present(0,1)) then
    call sic_i8 (line,0,1,nnn,.false.,error)
    if (error) return
  else
    ! Get with no argument
    ! Take previous one
    call check_index(error)
    if (error) return
    kx = r_xnum
    if (kx.le.0 .or. kx.ge.cxnext) then
      call message(6,3,'CLIC_GET','Please use GET with argument')
      error = .true.
      return
    endif
    call get_num(kx,error)
    if (error) return
    goto 30
  endif
  !
  ! Else search
  mmm = 0
  call sic_i4 (line,0,2,mmm,.false.,error)
  if (error) return
  call get_sub (nnn,mmm,error)
  if (error) return
  !
  ! Read data dump(s)
30 continue
  idump = 0
  if (sic_present(1,1)) then
    call sic_i4(line,1,1,idump,.true.,error)
    if (error) return
  endif
  kx = r_xnum
  if (got_header(kx)) then
    call robs(kx,error)
    if (error) return
    r_dobs = mod(r_dobs+32768,65536)-32768
    r_dred = mod(r_dred+32768,65536)-32768
  endif
  if (sic_present(2,0)) return
  !
  ! Get data
  call get_data(ldata_in,data_in,error)
  if (error) return
  if (idump.eq.0) then
    ! Select corrected/uncorrect record following /ATM
    ir = r_ndump + 1
    if (sic_present(3,0)) then
      if (r_ndatl.eq.2) then
        call message(6,1,'CLIC_GET',   &
          'selecting atm. phase corrected record')
        ir = r_ndump + 2
      else
        call message(6,3,'CLIC_GET',   &
          'No atm. phase corrected record in data')
        error = .true.
        return
      endif
    endif
  else
    if (sic_present(3,0)) then
      call message(6,3,'CLIC_GET',   &
        'conflicting options')
      error = .true.
      return
    endif
    ir = idump
  endif
  kin = gag_pointer(data_in,memory)
  ipk = kin + h_offset(ir)
  call decode_header (memory(ipk))
  !
  ! get only continuum if not average record..
  ipk = kin + c_offset(ir)
  k = 1
  if (r_lmode.eq.1) then
    do ib = 1, r_nbas
      do isb = 1, r_nsb
        call r4tor4 (memory(ipk),datac(k),2*r_nband)
        k = k + r_nband
        ipk = ipk+2*r_nband
      enddo
    enddo
  else
    do ib = 1, r_nant
      call r4toc4 (memory(ipk), datac(k), r_nband)
      call r4toc4 (memory(ipk), datac(k+r_nband), r_nband)
      k = k + 2*r_nband
      ipk = ipk + r_nband
    enddo
  endif
  ipk = kin + l_offset(ir)
  ! get continuum and line if average record ...
  k = 1
  if (r_lmode.eq.1) then
    do ib = 1, r_nbas
      do isb=1, r_lnsb
        call r4tor4 (memory(ipk),datal(k),2*r_lntch)
        k = k + r_lntch
        ipk = ipk+2*r_lntch
      enddo
    enddo
  else
    do ib = 1, r_nant
      call r4toc4 (memory(ipk), datal(k), r_lntch)
      call r4toc4 (memory(ipk), datal(k+r_lntch), r_lntch)
      k = k + 2*r_lntch
      ipk = ipk + r_lntch
    enddo
  endif
  call data_variables(.true.)
  call data_variables(.false.)
  !
  ! Notify
  if (idump.ne.0) then
    write (nombre,'(A,I12,A,I12)')   &
      ' Record ',dh_dump,' of ',r_ndump
  else
    write (nombre,'(A,I12)') ' Average Record of ',r_ndump
  endif
  call noir (nombre,nombre,n)
  call message(2,1,'GET',nombre(1:n))
  if (title%qual.eq.9) then
    call message(6,2,'GET','Observation marked for deletion')
  endif
  return
end subroutine clic_get
!
subroutine get_sub(nnn,mmm,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_index
  use clic_find
  use clic_rdata
  !---------------------------------------------------------------------
  !     GET Entry Version
  !---------------------------------------------------------------------
  integer(kind=entry_length) :: nnn                    !
  integer :: mmm                    !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  include 'clic_virtual.inc'
  ! Local
  integer(kind=entry_length) :: kx, i, ifound 
  integer :: nff, cver
  character(len=20) :: nombr1
  !------------------------------------------------------------------------
  ! Code:
  xnum=nnn
  ynum=nnn
  fnum=.true.
  if (mmm.le.0) then
    last=.true.
    fver=.false.
  else
    xver=mmm
    yver=mmm
    fver=.true.
    last=.false.
  endif
  !
  ! Search first in index
  kx = 0
  ifound = 0
  cver = 0
  if (last) then
    do i=1,cxnext-1
      if (cx_num(i).eq.xnum) then
        if (cx_ver(i).ge.0) then
          write(nombr1,'(I10)') xnum
          knext = i
          kx = cx_ind(i)
          call get_num(kx,error)
          return
        elseif (cx_ver(i).lt.cver) then
          ifound = i
          cver = cx_ver(i)
        endif
      endif
    enddo
    if (ifound.ne.0) then
      knext = ifound
      kx = cx_ind(ifound)
      call get_num(kx,error)
      return
    endif
  else
    do i=1,cxnext-1
      if (cx_num(i).eq.xnum .and. abs(cx_ver(i)).eq.xver) then
        kx = cx_ind(i)
        knext = i
        call get_num(kx,error)
        return
      endif
    enddo
  endif
  !
  ! Else, search in input file
  kx = 0
  nff=1
  error = .false.
  ykind = 3                    ! old format
  xkind = 4                    ! new format
  ! RL 05-oct-1987 do not wait for new data
  call fix(nff,kx,.false.,.false.,error)
  if (nff.eq.0) then
    if (fver) then
      write(nombr1,'(I10,A,I6)' ) xnum,';',abs(xver)
    else
      write(nombr1,'(I10)') xnum
    endif
    call message(8,3,'GET','Observation # '   &
      //nombr1(1:lenc(nombr1))//' not Found')
    error = .true.
    return
  endif
  call get_num(kx,error)
  return
end subroutine get_sub
!
subroutine get_it (kx,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_title
  use clic_index
  use clic_file, except=>i
  integer(kind=entry_length) :: kx                     !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_virtual.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: fsec
  integer :: j, i, min, n, ipol
  character(len=100) :: nombre
  integer(kind=address_length) :: ipv
  !
  call rzero                   ! initialise le buffer R
  if (got_header(kx)) then
    ipv = gag_pointer(v_header(kx),memory)
    call r4tor4 (memory(ipv),r_xnum,m_header)
  else
    call robs (kx,error)
    if (error) return
    do j=-mnsec,0
      r_presec(j) = fsec(j)
    enddo
    if (r_presec(interc_sec)) then
      call rinterc (error)
    else
      call message(8,3,'GET','No interferometer Configuration')
    endif
    !
    ! Patch in receiver 2 data
    if (r_presec(atmon_sec)) then
      call ratmon (error)
      do i=1, r_nant
        r_tsys_mon(i) = min(r_tsys_mon(i),1e10)
        r_tsys_mon(i) = max(0.,r_tsys_mon(i))
      enddo
    elseif(e%version.lt.2) then
      call fill_rec2(kx,error)
    endif
    ! WVR Data
    if (r_presec(wvr_sec)) then
      call rwvr(error)
    endif
    !
    r_dobs = mod(r_dobs+32768,65536)-32768
    r_dred = mod(r_dred+32768,65536)-32768
    r_xnum = kx
    title%ver = abs(title%ver)
    call rgen (error)          ! infos generales
    error=.false.
    if (r_kind.le.2) then
      call message(8,3,'GET_FIRST','Observation is Single-Dish')
      error = .true.
      return
    endif
    call rpos (error)          ! positions
    error = .false.
    !
    ! Others are independent of kind
    if (r_presec(rfset_sec)) then
      call rrfset (error)
    else
      call message(8,3,'GET','No RF Setup')
    endif
    !
    if (r_presec(contset_sec)) then
      call rcontset (error)
    endif
    if (r_presec(lineset_sec)) then
      call rlineset (error)
    endif
    if (r_presec(atparm_sec)) then
      call ratparm (error)
      do i=1, r_nant
        do ipol = 1, r_npol_rec
          r_tsyss(ipol,i) = min(r_tsyss(ipol,i),1e10)
          r_tsyss(ipol,i) = max(0.,r_tsyss(ipol,i))
          r_tsysi(ipol,i) = min(r_tsysi(ipol,i),1e10)
          r_tsysi(ipol,i) = max(0.,r_tsysi(ipol,i))
        enddo
      enddo
    endif
    call check_eff
    if (r_presec(scanning_sec)) then
      call rscanning (error)
    endif
    if (r_presec(alma_sec)) then
      call ralma(error)
    endif
    if (r_presec(monitor_sec)) then
      call rmoni(error)
    endif
    if (r_presec(bpcal_sec)) then
      call rbpcal (error)
    else
      r_bpc = 0
    endif
    if (r_presec(ical_sec)) then
      call rical (error)
    else
      r_ic = 0
    endif
    ! antenna based calibrations
    if (r_presec(abpcal_sec)) then
      call rabpcal (error)
    else
      r_abpc = 0
    endif
    if (r_presec(aical_sec)) then
      call raical (error)
    else
      r_aic = 0
    endif
    ! Data descriptor
    if (r_presec(descr_sec)) then
      call rdescr (error)
    else
      call message(8,3,'GET','No Data Section Descriptor')
      error = .true.
      return
    endif
    if (r_presec(file_sec)) then
      call rdfile (error)
    endif
    if (r_presec(modify_sec)) then
      call rdmodif (error)
    endif
    !
    ! Some more memory
    call get_memory(int(m_header,kind=address_length),v_header(kx),error)
    if (error) then
      call message(8,4,'GET_IT','Problems with getting memory')
      return
    endif
    ipv = gag_pointer(v_header(kx),memory)
    call r4tor4 (r_xnum,memory(ipv),m_header)
  endif
  if (.not.got_header(kx)) then
    got_header(kx) = .true.
  endif
  write (nombre,'(A,I12,A,I12,A,I12)') 'Entry ',r_xnum,   &
    ' Observation ',r_num,';',abs(r_ver)
  call noir (nombre,nombre,n)
  call message(2,1,'GET',nombre)
  return
end subroutine get_it
!
subroutine fill_rec2(kx,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_index
  use clic_find
  !---------------------------------------------------------------------
  ! fill in atmospheric data from receiver 2
  !---------------------------------------------------------------------
  integer(kind=entry_length) :: kx                     !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_virtual.inc'
  include 'gbl_memory.inc'
  include 'clic_clic.inc'
  ! Local
  integer :: nff, i, j
  integer(kind=entry_length) :: iff(2),kxsave
  integer(kind=address_length) :: ipv
  logical :: fsec
  !-----------------------------------------------------------------------
  kxsave = kx
  if (r_presec(interc_sec)) call rinterc (error)
  if (r_presec(atparm_sec)) call ratparm (error)
  if (r_presec(rfset_sec)) call rrfset (error)
  if (r_nrec.ne.2) then
    nff = 2
    fnum = .false.
    xscan(1) = r_scan
    yscan(1) = r_scan
    xnscan = 1
    fscan = .true.
    xrecei = 2
    call fix(nff,iff,.false.,.false.,error)
    error = .false.
    if (nff.lt.1) then
      call message(4,2,'FILL_REC2',   &
        'Receiver 2 parameters are not available')
      r_presec(atmon_sec) = .false.
      return
    endif
    kx = iff(1)
    call rzero                 ! initialise le buffer R
    if (got_header(kx)) then
      ipv = gag_pointer(v_header(kx),memory)
      call r4tor4 (memory(ipv),r_xnum,m_header)
    else
      call robs(kx,error)
      do j=-mnsec,0
        r_presec(j) = fsec(j)
      enddo
      if (r_presec(interc_sec)) call rinterc (error)
      if (r_presec(rfset_sec)) call rrfset (error)
      if (r_presec(atparm_sec)) call ratparm (error)
    endif
  endif
  r_frs_mon = r_flo1+r_isb*r_fif1
  r_fri_mon = r_flo1-r_isb*r_fif1
  r_nrec_mon = 2
  !
  ! use first polar, may be should average if 2 had been present...
  ! but there was only one at the time.
  !
  do i=1, r_nant
    r_h2o_mon(i) = r_h2omm(1,i)
    r_tatms_mon(i) = r_tatms(1,i)
    r_tatmi_mon(i) = r_tatmi(1,i)
    r_taus_mon(i) = r_taus(1,i)
    r_taui_mon(i) = r_taui(1,i)
    r_feff_mon(i) = r_feff(1,i)
    r_tchop_mon(i) = r_tchop(1,i)
    r_tcold_mon(i) = r_tcold(1,i)
    r_trec_mon(i) = r_trec(1,i)
    r_gim_mon(i) = r_gim(1,i)
    r_csky_mon(i) = r_csky(1,i)
    r_cchop_mon(i) = r_cchop(1,i)
    r_ccold_mon(i) = r_ccold(1,i)
    r_cmode_mon(i) = r_cmode(1,i)
  enddo
  if (kx.ne.kxsave) then
    kx = kxsave
    call robs(kx,error)
    do j=-mnsec,0
      r_presec(j) = fsec(j)
    enddo
    if (r_presec(interc_sec)) call rinterc (error)
  endif
  r_presec(atmon_sec) = .true.
  call message(8,2,'FILL_REC2',   &
    'Receiver 2 parameters patched in')
  return
end subroutine fill_rec2
!
subroutine check_eff
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !	Define Efficiencies if not known.
  !---------------------------------------------------------------------
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  ! Local
  integer :: i, ipol
  !------------------------------------------------------------------------
  ! Code:
  do i=1, r_nant
    do ipol=1, r_npol_rec
      if (r_jykel(ipol,i).le.0) then
        if (r_beef(ipol,i).gt.0) then
          r_jykel(ipol,i) = 18.7/r_beef(ipol,i)
        else
          r_jykel(ipol,i) = 22.
        endif
      endif
    enddo
  enddo
end subroutine check_eff
!
subroutine get_memory(length,address,error)
  use gildas_def
  use gkernel_interfaces
  use clic_file
  use clic_index
  !---------------------------------------------------------------------
  ! Get some virtual memory, new or used.
  !---------------------------------------------------------------------
  integer(kind=address_length) :: length  ! Memory length
  integer(kind=address_length) :: address ! Memory adress
  logical :: error                        ! Error logical flag
  ! Global
  include 'clic_parameter.inc'
  include 'clic_virtual.inc'
  ! Local
  integer :: j, k, ier
  real :: space_clic
  character*6 :: ch
  !------------------------------------------------------------------------
  ! Code:
  if (n_regions.eq.0) then
    n_regions = 1
    current_region = 1
    ! Simplify the previous scheme. locical name SPACE_CLIC is the number of
    ! Megabytes available for CLIC. Should be tuned for each system ...
    space_clic = 1024
    ier = sic_ramlog('SPACE_CLIC',space_clic)
    if (ier.ne.0) then
      ! Not found or translation failed
      call message(8,2,'GET_MEMORY','Trying to get 1024 Mbytes')
    endif
    region_length(1:m_region) = space_clic*1024*256/m_region
    error = (sic_getvm(region_length(1),region(1)).ne.1)
    if (error) return
  endif
  k = current_region
  ! Move to next region ?
  if (length+next_offset .gt. region_length(k)) then
    next_offset = 0
    k = k + 1
    if (k.gt.m_region) k = 1
    if (k.gt.n_regions) then
      error = (sic_getvm(region_length(k),region(k)).ne.1)
      if (error) return      
      n_regions = n_regions + 1
    endif
    current_region = k
    if (length.gt.region_length(k)) then
      call message(6,4,'GET_MEMORY', &
           'SPACE_CLIC is too small to handle this observation')
      write(ch,'(i3)') int(length*4/1000/1000)+1
      call message(6,2,'GET_MEMORY', &
           'You need at least '//ch(1:lenc(ch))//'MB')
      call sysexi(fatale)
    endif
  endif
  address = region(current_region)+next_offset*4
  next_offset = next_offset+length
  do j=1, i%desc%xnext-1
    if (got_header(j)) then
      if (v_header(j).ge.address   &
        .and. v_header(j).lt.address+length*4) then
        got_header(j) = .false.
      endif
    endif
    if (got_data(j)) then
      if (v_data(j).ge.address   &
        .and. v_data(j).lt.address+length*4) then
        got_data(j) = .false.
      endif
    endif
  enddo
  return
end subroutine get_memory
!
subroutine new_file
  use gildas_def
  use clic_index
  !---------------------------------------------------------------------
  ! A New File : deassign IO channel, unmap all sections, open again
  !---------------------------------------------------------------------
  ! Global
  include 'clic_parameter.inc'
  include 'clic_virtual.inc'
  ! Local
  integer :: i
  !------------------------------------------------------------------------
  ! Code:
  !
  do i=1, m_ix
    got_header(i) = .false.
    got_data(i) = .false.
  enddo
  current_region = min(current_region,1)
  next_offset = 0
  return
end subroutine new_file

subroutine free_memory
  use gildas_def
  use gkernel_interfaces
  use clic_file,except=>i
  use clic_index
  include 'clic_parameter.inc'
  include 'clic_virtual.inc'
  integer :: i
  do i=1, n_regions
    call free_vm(region_length(i),region(i))
  enddo
  do i=1, m_ix
    got_header(i) = .false.
    got_data(i) = .false.
  enddo
  n_regions=0
  return
end subroutine free_memory
