subroutine liste(line,error)
  use gildas_def
  use gkernel_types
  use gkernel_interfaces
  use clic_file
  use clic_title
  use clic_index 
  !---------------------------------------------------------------------
  ! CLIC 	Internal routine
  !	Liste breve,normale ou longue d'un ensemble d'observations
  !	Construit par find (LIST)
  !	Tout le fichier d'entree (LIST IN[file])
  !	Tout le fichier de sortie (LIST OU[tfile])
  !	LIST OUT supported except for LONG
  !	/OUTPUT File	Send to a file
  !	/FLAGS  (4)
  !	/SHORT	(5)
  !	/PROJECT (6)
  !       /SOURCE   (7)
  !       /VARIABLE (8) [/FORMAT (9)]
  ! Arguments :
  !	LINE	C*(*)	Command line			Input
  !	ERROR	L	Logical error flag		Output
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  ! Local
  integer :: p_lun
  character(len=1) :: type1
  character(len=80) :: snam,filnam
  common /ciout/ p_lun,type1,filnam
  type(title_v2_t) :: title_save
  !
  logical :: in,out,brief,long,print,flag, short, format, variable,mem
  logical :: flagged
  integer :: lsave(32), isave
  integer :: lchain, j, tnum, tver, lch
  integer(kind=entry_length) :: k,kmax,kk
  character(len=80) :: chaine, ch
  !
  integer :: mproje
  parameter (mproje=32)
  integer :: nproje,jproje(mproje),ifo, nch
  character(len=8) :: cproje(mproje),cprojec
  logical :: lproje
  !
  integer :: msour
  parameter (msour=1024)
  integer :: nsour, jsour(msour)
  character(len=12) :: csour(msour), csourc
  logical :: lsour
  integer :: mtele
  parameter (mtele = 32)
  integer :: ntele, jtele(mtele)  
  character(len=12) :: ctele(mtele), cteles
  logical :: ltele
  integer :: moffpos
  parameter (moffpos=64)
  integer :: noffpos, joffpos(moffpos)
  real :: off_pos(2,moffpos)
  logical :: loff
  logical :: band
  !
  integer :: nv, mv, level
  parameter (mv=100)
  character(len=64) :: arg
  character(len=12) :: form(mv)
  integer(kind=address_length) :: addr(mv), type(mv)
  type(sic_descriptor_t) :: desc
  logical :: found
  integer(kind=index_length) :: dim(4)
  !
  save nsour,csour
  save nproje,cproje
  save ntele,ctele
  save noffpos, off_pos
  !
  integer :: mg
  parameter (mg=1000)
  integer :: ng, sg(2,mg)
  common/scan_group/ng, sg
  save /scan_group/
  !
  integer :: mvoc1, nkey
  parameter (mvoc1=3)
  character(len=12) :: kw, voc1(mvoc1)
  data voc1/'IN','OUT','*'/
  !
  data nproje/0/
  data nsour/0/
  !------------------------------------------------------------------------
  !
  ! Verify if any input file
  !
  kw = '*'
  call clic_kw(line,0,1,kw,nkey,voc1,mvoc1,.false.,error,.true.)
  if (error) goto 999
  in  = kw.eq.'IN'
  out = kw.eq.'OUT'
  !
  if (.not.in .and. .not.out) then
    call check_index(error)
    if (error) goto 999
  endif
  if (in) call check_input_file(error)
  if (out) call check_output_file(error)
  if (error) goto 999
  !
  ! options:
  brief = sic_present(1,0)
  long = sic_present(2,0) .and. .not.brief
  print = sic_present(3,0)
  flag = sic_present(4,0)
  short = sic_present(5,0)
  lproje = sic_present(6,0)
  lsour = sic_present(7,0) .and. .not.lproje
  ltele = sic_present(12,0).and. .not.lproje .and. .not.lsour 
  loff = sic_present(10,0) .and. .not.lproje .and. .not.lsour .and..not.ltele
  variable = sic_present(8,0)
  format = variable .and. sic_present(9,0)
  mem = sic_present(11,0)
  band = sic_present(13,0)
  if (band) then
    call list_bandpass(error)
    return
  endif
  !
  ! no printout for /SOURCE or /PROJECT
  print = print .and. .not.lsour .and. .not.lproje
  !
  call sic_delvariable('N_GROUP',.false.,error)
  call sic_delvariable('S_GROUP',.false.,error)
  error = .false.
  ng = 0
  do j=1, mg
    sg(1,j) = 0
    sg(2,j) = 0
  enddo
  if (lproje) then
    if (brief .or. long .or. flag .or. print) then
      call message(6,3,'LISTE','Incompatible options')
      goto 999
    endif
    call sic_delvariable('N_PROJECT',.false.,error)
    call sic_delvariable('C_PROJECT',.false.,error)
    error = .false.
    nproje = 0
    do j=1,mproje
      jproje(j) = 0
    enddo
  elseif (lsour) then
    if (brief .or. long .or. flag .or. print) then
      call message(6,3,'LISTE','Incompatible options')
      goto 999
    endif
    call sic_delvariable('N_SOURCE',.false.,error)
    call sic_delvariable('C_SOURCE',.false.,error)
    error = .false.
    nsour = 0
    do j=1,msour
      jsour(j) = 0
    enddo
  elseif (ltele) then
    if (brief .or. long .or. flag .or. print) then
      call message(6,3,'LISTE','Incompatible options')
      goto 999
    endif
    call sic_delvariable('N_TELESCOPE',.false.,error)
    call sic_delvariable('C_TELESCOPE',.false.,error)
    error = .false.
    ntele = 0
    do j=1,mtele
      jtele(j) = 0
    enddo
  elseif (loff) then
    if (brief .or. long .or. flag .or. print) then
      call message(6,3,'LISTE','Incompatible options')
      goto 999
    endif
    call sic_delvariable('N_OFFPOS',.false.,error)
    call sic_delvariable('OFF_POS',.false.,error)
    error = .false.
    noffpos = 0
    do j=1,moffpos
      joffpos(j) = 0
    enddo
  endif
  !
  ! Output file
  if (print) then
    call sic_ch(line,3,1,snam,nch,.true.,error)
    if (error) goto 999
    call sic_parsef(snam,filnam,' ','.lis')
    call out0('File',0,0,error)
    if (error) return
  else
    call out0('Terminal',0,0,error)
  endif
  !
  ! Variables and associated formats
  if (variable) then
    nv = 0
    do j=1, sic_narg(8)
      call sic_ke(line,8,j,arg,nch,.true.,error)
      if (error) return
      call sic_descriptor (arg,desc,found)
      if (.not.found) then
        call message(6,2,'LISTE',arg(1:nch)//' undefined')
      elseif (nv.lt.mv) then
        nv = nv+1
        type(nv) = desc%type
        addr(nv) = desc%addr
        form(nv) = '*'
        if (j.le.sic_narg(9)) then
          call sic_ke(line,9,j,arg,nch,.true.,error)
          if (error) return
          if (arg(1:1).ne.'*') then
            form(nv) = '('//arg(1:nch)//')'
          endif
        endif
      else
        call message(6,2,'LISTE',arg(1:nch)//' ignored')
      endif
    enddo
  endif
  !
  if (in) then
    kmax = i%desc%xnext-1
    if (kmax.le.0) then
      call message(1,1,'LISTE','Input file is empty')
      return
    elseif (.not.print) then
      call message(1,1,'LISTE','Input file contains :')
    endif
  elseif (out) then
    kmax = o%desc%xnext-1
    if (kmax.le.0) then
      call message(1,1,'LISTE','Output file is empty')
      return
    elseif (.not.print) then
      call message(1,1,'LISTE','Output file contains :')
    endif
  else
    kmax = cxnext - 1
    if (kmax.le.0) then
      call message(1,1,'LISTE','Current index is empty')
      return
    elseif (.not.print .and. .not.flag) then
      call message(1,1,'LISTE','Current index :')
    endif
  endif
  !
  ! loop on index entries
  !
  title_save = title
  !
  flagged = .false.
  lchain = 1
  level = 6
  call message_level(level)
  do k = 1,kmax
    kk=k
    !
    ! Brief: all is available
    ! may be scan numbers instead ?
    if (brief) then
      if (in) then
        tnum = ix_num(k)
        tver = ix_ver(k)
      elseif (out) then
        tnum = ox_num(k)
        tver = ox_ver(k)
      else
        tnum = cx_num(k)
        tver = cx_ver(k)
      endif
      if (lchain.gt.69) then
        call outlin(chaine,lchain-1)
        lchain = 1
      endif
      tver = abs(tver)
      write(chaine(lchain:),1006) tnum,tver
1006  format(i6,';',i3)
      lchain=lchain+12
    !
    ! Long (only input file)
    elseif (long .and. .not.out) then
      if (.not.in) kk = cx_ind(k)
      call get_num(kk,error)
      if (error) goto 100
      ! Duplicate Index information for TITOUT (was missing before)
      title%num = r_num
      title%ver = r_ver
      title%dobs =r_dobs
      title%dred = r_dred
      title%typec =r_typec
      title%kind = r_kind
      title%qual = r_qual
      title%scan = r_scan
      title%recei = r_nrec
      call chtoby(r_project,title%project,8)
      call chtoby(r_teles,title%teles,12)
      call titout ('Long',error)
      write(p_lun,'(1x,a)') ' '
    !
    ! Normal or /project or  /Flag or /Source or /VARIABLE
    else
      if (in) then
        call rix(k,error)
      elseif (out) then
        call rox(k,error)
      else
        kk = cx_ind(k)
        call rix(kk,error)
      endif
      if (error) go to 100
      if (short .and. .not.variable) then
        call titout('Short',error)
      ! Flags
      elseif (flag) then
        if (.not.in) then
          kk = cx_ind(k)
        else
          kk = k
        endif
        isave = 5
        call message_level(isave)
        call get_num(kk,error)
        if (error) goto 100
        call message_level(isave)
        call list_all_flags (p_lun,flagged,mem,error)
        if (error) goto 998
      ! Project
      elseif (lproje) then
        call bytoch(title%project,cprojec,8)
        ifo = 0
        do j=1,nproje
          if (cprojec.eq.cproje(j)) then
            ifo = j
            jproje(j) = jproje(j)+1
          endif
        enddo
        if (ifo.eq.0) then
          nproje = nproje+1
          cproje(nproje) = cprojec
          jproje(nproje) = 1
        endif
      ! Source
      elseif (lsour) then
        call bytoch(title%sourc,csourc,12)
        ifo = 0
        do j=1,nsour
          if (csourc.eq.csour(j)) then
            ifo = j
            jsour(j) = jsour(j)+1
          endif
        enddo
        if (ifo.eq.0) then
          nsour = nsour+1
          csour(nsour) = csourc
          jsour(nsour) = 1
        endif
      elseif (ltele) then
        call bytoch(title%teles,cteles,12)
        ifo = 0
        do j=1,ntele
          if (cteles.eq.ctele(j)) then
            ifo = j
            jtele(j) = jtele(j)+1
          endif
        enddo
        if (ifo.eq.0) then
          ntele = ntele+1
          ctele(ntele) = cteles
          jtele(ntele) = 1
        endif
      elseif (loff) then
        ifo = 0
        do j=1,noffpos
          if (title%off1.eq.off_pos(1,j).and.title%off2.eq.off_pos(2,j))   &
            then
            ifo = j
            joffpos(j) = joffpos(j)+1
          endif
        enddo
        if (ifo.eq.0) then
          noffpos = noffpos+1
          off_pos(1,noffpos) = title%off1
          off_pos(2,noffpos) = title%off2
          joffpos(noffpos) = 1
        endif
      elseif (variable) then
        if (.not.in) kk = cx_ind(k)
        call get_num(kk,error)
        if (error) goto 100
        call vartitout(short,r_scan,   &
          nv,type,addr,form,.false.,error)
      else
        call titout('Normal',error)
      endif
      if (error) return
    endif
    if (sic_ctrlc()) then
      error = .true.
      goto 101
    endif
100 error = .false.
  enddo
  !
  ! Close
  if (lchain.gt.1) call outlin(chaine,lchain)
  if (flag .and. .not.flagged) call outlin('No flags',8)
  call message_level(level)
  !
101 continue
  if (lproje) then
    isave = 5
    call message_level(isave)
    do j=1,nproje
      write(snam,'(A,I2,4X,A,I5,A)') 'Project #',j,cproje(j),   &
        jproje(j),' Observations'
      call message(5,1,'LISTE',snam)
    enddo
    call message_level(isave)
    call sic_def_inte('N_PROJECT',nproje,0,1,.true.,error)
    call sic_def_charn('C_PROJECT',cproje,1,nproje,.true.,   &
      error)
  elseif (lsour) then
    isave = 5
    call message_level(isave)
    do j=1,nsour
      write(snam,'(A,I3,4X,A,I5,A)') 'Source #',j,csour(j),   &
        jsour(j),' Observations'
      call message(5,1,'LISTE',snam)
    enddo
    call message_level(isave)
    call sic_def_inte('N_SOURCE',nsour,0,1,.true.,error)
    call sic_def_charn('C_SOURCE',csour,1,nsour,.true.,   &
      error)
  elseif (ltele) then
    isave = 5
    call message_level(isave)
    do j=1,ntele
      write(snam,'(A,I3,4X,A,I5,A)') 'Telescope #',j,ctele(j),   &
        jtele(j),' Observations'
      call message(5,1,'LISTE',snam)
    enddo
    call message_level(isave)
    call sic_def_inte('N_TELESCOPE',ntele,0,1,.true.,error)
    call sic_def_charn('C_TELESCOPE',ctele,1,ntele,.true.,   &
      error)
  elseif (loff) then
    isave = 5
    call message_level(isave)
    do j=1,noffpos
      call offsec(off_pos(1,j),ch(1:),error)
      lch = 7
      call offsec(off_pos(2,j),ch(lch+1:),error)
      lch = lch+7
      write(snam,'(A,I2,4X,a,I5,A)') 'Offset Position #',j,   &
        ch(1:lch),   &
        joffpos(j),' Observations'
      call message(5,1,'LISTE',snam)
    enddo
    call message_level(isave)
    call sic_def_inte('N_OFFPOS',noffpos,0,1,.true.,error)
    dim(1) = 2
    dim(2) = noffpos
    call sic_def_real('OFF_POS',off_pos,2,dim,.true.,error)
  else
    if (short) then
      if (variable) then
        call vartitout(short,r_scan,nv,type,addr,form,.true.,error)
      else
        call titout('Zhort',error)
      endif
    endif
    if (error) return
    call out1(error)
    call sic_def_inte('N_GROUP',ng,0,1,.true.,error)
    dim(1) = 2
    dim(2) = ng
    call sic_def_inte('S_GROUP',sg,2,dim,.true.,error)
    if (print.and..not.error) then
      call message(2,1,'LISTE','List on file '   &
        //filnam(1:lenc(filnam)))
    endif
  endif
  !
  ! recupere le titre court
998 continue
  title = title_save
  return
  !
999 error = .true.
end subroutine liste
!
subroutine list_all_flags(lun,flagged,mem,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use clic_index
  !---------------------------------------------------------------------
  ! List flagged data from scan in R on unit LUN
  ! set FLAGGED logical if flags were found.
  !---------------------------------------------------------------------
  integer :: lun                    !
  logical :: flagged                !
  logical :: mem                    !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'gbl_memory.inc'
  ! Local
  integer(kind=address_length) :: data_in, kin, ipk
  integer(kind=data_length)    :: ndata
  integer :: oldaf(mnant), oldbf(mnbas), i, ir, j
  logical :: oldsa(2*mbands,mnant), oldsb(2*mbands,mnbas)
  integer :: ir1, ir2
  logical :: dum_saflag(2*mbands,mnant),dum_sbflag(2*mbands,mnbas)
  logical :: change, f
  character(len=1024) :: out
  !------------------------------------------------------------------------
  ! Code:
  f = .false.
  dum_saflag = .false.
  dum_sbflag = .false.
  if (mem) then
    call list_flags(r_nant,r_nbas,ix_aflag(1,r_xnum),ix_bflag(1,r_xnum),&
        dum_saflag,dum_sbflag,out)
    if (out(1:2).ne.'no') then
      write(lun,'(a,i4,a)') '--- Scan ',r_scan,' flagged in memory ---'
      write(lun,1001,err=998) out(1:lenc(out))
      f = .true.
    endif 
    flagged = flagged .or. f
    return
  endif
  call get_data (ndata,data_in,error)
  if (error) goto 999
  kin = data_in + r_ndump*r_ldump*4
  ipk = gag_pointer(kin,memory)
  call decode_header (memory(ipk))
  call list_flags(r_nant,r_nbas,dh_aflag,dh_bflag,&
     dh_saflag,dh_sbflag,out)
  if (out(1:2).ne.'no') then
    write(lun,'(a,i4,a)') '--- Scan ',r_scan,' flagged ---'
    write(lun,1001,err=998) out(1:lenc(out))
    f = .true.
  endif
  !
  ! Loop on records
  do ir = 1, r_ndump
    kin = data_in + (ir-1)*r_ldump*4
    ipk = gag_pointer(kin,memory)
    call decode_header (memory(ipk))
    change = .false.
    if (ir.eq.1) then
      do i=1, r_nant
        oldaf(i) = dh_aflag(i)
        do j=1, 2*mbands
          oldsa(j,i) = dh_saflag(j,i)
        enddo
      enddo
      do i=1, r_nbas
        oldbf(i) = dh_bflag(i)
        do j=1, 2*mbands
          oldsb(j,i) = dh_sbflag(j,i)
        enddo
      enddo
      ir1 = 1
    else
      do i=1, r_nant
        change = change.or.dh_aflag(i).ne.oldaf(i)
        do j=1, 2*mbands
          change = change.or.dh_saflag(j,i).neqv.oldsa(j,i)
        enddo
      enddo
      do i=1, r_nbas
        change = change.or.dh_bflag(i).ne.oldbf(i)
        do j=1, 2*mbands
          change = change.or.dh_sbflag(j,i).neqv.oldsb(j,i)
        enddo
      enddo
    endif
    if (change .or. ir.eq.r_ndump) then
      ir2 = ir-1
      if (.not.change) ir2 = ir
      call list_flags(r_nant,r_nbas,oldaf,oldbf,oldsa,oldsb,out)
      if (out(1:2).ne.'no') then
        if (.not.f) then
          write(lun,'(a,i4,a)')   &
            '--- Scan ',r_scan,' flagged ---'
          f = .true.
        endif
        write(lun,1000,err=998) ir1, ir2, out(1:lenc(out))
      endif
      if (change.and.ir.eq.r_ndump) then
        call list_flags(r_nant,r_nbas,dh_aflag,dh_bflag, &
          dh_saflag,dh_sbflag,out)
        if (out(1:2).ne.'no') then
          if (.not.f) then
            write(lun,'(a,i4,a)')   &
              '--- Scan ',r_scan,' flagged ---'
            f = .true.
          endif
          write(lun,1000,err=998) r_ndump, r_ndump, out(1:lenc(out))
        endif
      endif
      do i=1, r_nant
        oldaf(i) = dh_aflag(i)
        do j=1, 2*mbands
          oldsa(j,i) = dh_saflag(j,i)
        enddo
      enddo
      do i=1, r_nant
        oldbf(i) = dh_bflag(i)
        do j=1, 2*mbands
          oldsb(j,i) = dh_sbflag(j,i)
        enddo
      enddo
      ir1 = ir
    endif
  enddo
  flagged = flagged .or. f
  return
  !
998 call message(6,3,'LIST_ALL_FLAGS','Write error')
999 error = .true.
  return
1000 format(' Records ',i3,' to ',i3,' - ',a)
1001 format(' Average Record - ',a)
end subroutine list_all_flags
!
subroutine list_bandpass(error)
  use gkernel_interfaces
  use clic_file
  use clic_title
  use clic_index
  use clic_find
  !
  logical :: error
  !
  include 'clic_proc_par.inc'
  !
  type(title_v2_t) :: title_save
  integer(kind=entry_length),allocatable :: cx_num_sav(:),cx_ind_sav(:)
  integer(kind=8),allocatable ::cx_bloc_sav(:)
  integer,allocatable :: cx_word_sav(:),cx_ver_sav(:)
  integer(kind=entry_length) :: cxnext_sav,knext_sav,kk,ifind(max_rf_file)
  integer :: nnn
  integer :: ier, j, indlen
  character(len=*), parameter :: rname='LIST_BAND'
  !
  ! First save current index
  indlen = 0
  if (cxnext.gt.1) then
    indlen = cxnext-1
    allocate(cx_num_sav(indlen),cx_ind_sav(indlen),cx_bloc_sav(indlen), &
             cx_word_sav(indlen),cx_ver_sav(indlen),stat=ier)
    if (failed_allocate(rname,'Cannot allocate index',ier,error))  return
    do j=1,indlen
      cx_num_sav(j) = cx_num(j)
      cx_ind_sav(j) = cx_ind(j)
      cx_bloc_sav(j) = cx_bloc(j)
      cx_word_sav(j) = cx_word(j)
      cx_ver_sav(j) = cx_ver(j)
    enddo
    cxnext_sav = cxnext
    knext_sav = knext
  endif
  !
  ! Search for bandpass solutions
  fscan = .false.
  fexcl = .false.
  fsourc = .false.
  fproc = .true.
  xnproc = 1
  xsproc(1) = p_band
  fnum = .false.
  fline = .false.
  fitype = .false.
  fteles = .false.
  !fproject = .false.
  fdobs = .false. 
  fdred = .false.
  foff1 = .false. 
  foff2 = .false.
  fut = .false.
  fhoura= .false.
  fic = .false.
  fbpc = .false.
  fpol = .false.
  fskip = .false.
  fload = .false.
  xnscan = 1
  xscan(1) = scan_offset
  yscan(1) = 2147483647
  !
  cxnext = 1
  knext = 0
  nnn  = max_rf_file*2
  call fix(nnn,ifind(1),.true.,.false.,error)
  if (error) goto 100
  ! 
  ! Save title
  title_save = title
  !
  ! Now do the listing
  if (nnn.le.0) then
    call message(8,1,'LIST_BAND','No bandpass solution found')
  else
    call out0('Terminal',0,0,error)
     if (error) return
    do j=1,cxnext-1
      kk = cx_ind(j)
      call rix(kk,error)
      if (error) goto 100
      call titout('Normal',error)
      if (error) goto 100
    enddo
  endif
  !
  ! Restore saved title and index
  title = title_save
  if (indlen.gt.0) then
    do j=1,indlen
      cx_num(j) = cx_num_sav(j)
      cx_ind(j) = cx_ind_sav(j)
      cx_bloc(j) = cx_bloc_sav(j)
      cx_word(j) = cx_word_sav(j)
      cx_ver(j) = cx_ver_sav(j)
    enddo
    cxnext = cxnext_sav
    knext = knext_sav
  endif
100  continue
  if (allocated(cx_num_sav)) deallocate(cx_num_sav)
  if (allocated(cx_ind_sav)) deallocate(cx_ind_sav)
  if (allocated(cx_bloc_sav)) deallocate(cx_bloc_sav)
  if (allocated(cx_word_sav)) deallocate(cx_word_sav)
  if (allocated(cx_ver_sav)) deallocate(cx_ver_sav)
  return
end subroutine list_bandpass



