subroutine format_catalog(line,error)
  use gbl_message
  use astro_interfaces, except_this=>format_catalog
  !---------------------------------------------------------------------
  ! @ private
  !	ASTRO Command CATALOG  name /VELETA
  !---------------------------------------------------------------------
  character(len=*), intent(inout):: line           !
  logical, intent(inout) :: error                  !
  ! Global
  integer(kind=4) :: lenc,sic_getlun,sic_open
  ! Local
  character(len=80) :: c_sbas,c_seqn,c_slam,c_sbet,c_vhel,c_vlsr,c_snam
  character(len=80) :: c_flux
  integer(kind=4) :: l_sbas,l_seqn,l_slam,l_sbet,l_vhel,l_vlsr,l_snam,l_flux
  logical :: i_sbas,i_seqn,i_slam,i_sbet,i_vhel,i_vlsr,i_flux
  common /source_infc/ c_sbas,c_seqn,c_slam,c_sbet,c_vhel,c_vlsr,c_snam,c_flux
  common /source_infi/ l_sbas,l_seqn,l_slam,l_sbet,l_vhel,l_vlsr,l_snam,  &
                l_flux,i_sbas,i_seqn,i_slam,i_sbet,i_vhel,i_vlsr,i_flux
  character(len=132) :: c_line
  character(len=80) :: name, file, c_snam_t
  integer(kind=4) :: nlu, olun, lun, icom, l_snam_t, ier, nc
  character(len=7) :: rname
  data rname /'CATALOG'/
  ! Code ------------------------------------------------------------------
  !
  ! Open input catalog
  call sic_ch (line,0,1,name,nc,.true.,error)
  if (error) return
  error = .true.
  call sic_parsef(name,file,' ','.cat')
  ier = sic_getlun(lun)
  ier = sic_open(lun,file,'OLD',.true.)
  if (ier.ne.0) then
    call astro_message(seve%e,rname,'Error opening '//file)
    goto 998
  endif
  !
  ! Open output catalog
  call sic_parsef(name,file,' ','.sou')
  ier = sic_getlun (olun)
  ier = sic_open(olun,file,'NEW',.false.)
  if (ier.ne.0) then
    call astro_message(seve%e,rname,'Error opening '//file)
    goto 997
  endif
  l_snam = 0
  l_sbas = 0
  l_seqn = 0
  l_slam = 0
  l_sbet = 0
  l_vlsr = 0
  l_vhel = 0
  l_flux = 0
  i_sbas = .false.
  i_seqn = .false.
  i_slam = .false.
  i_sbet = .false.
  i_vlsr = .false.
  i_vhel = .false.
  i_flux = .false.
  error = .false.
  !
  ! Start reading
  100   read(lun,'(A)',end=997) c_line
  nlu = lenc(c_line)
  if (nlu.eq.0) goto 100
  icom = index(c_line(1:nlu),'!')-1
  if (icom.eq.-1) icom = nlu   ! no comment
  if (icom.gt.0) icom = lenc(c_line(1:icom))
  if (icom.eq.0) then
    write(olun,'(A)') c_line(1:nlu)
    goto 100
  elseif (c_line(1:1).eq.'*') then
    write(olun,'(A)') '!'//c_line(2:nlu)
    goto 100
  elseif (index(c_line(1:icom),'STOP') .ne. 0) then
    if (l_snam .ne. 0 .and. l_slam.ne.0 .and. l_sbet.ne.0) then
      call output_line(olun,error)
      if(error) goto 98
    endif
    goto 997
  elseif (index(c_line(1:icom),'COMMON:') .ne. 0) then
    call sic_upper(c_line(1:icom))
    if (l_snam .ne. 0 .and. l_slam.ne.0 .and. l_sbet.ne.0) then
      call output_line(olun,error)
      if(error) goto 98
      l_snam = 0
    endif
    call getpar(c_line(1:icom),'SBAS',c_sbas,l_sbas)
    call getpar(c_line(1:icom),'SEQN',c_seqn,l_seqn)
    call getpar(c_line(1:icom),'SLAM',c_slam,l_slam)
    call getpar(c_line(1:icom),'SBET',c_sbet,l_sbet)
    call getpar(c_line(1:icom),'VHEL',c_vhel,l_vhel)
    call getpar(c_line(1:icom),'VLSR',c_vlsr,l_vlsr)
    goto 100
  elseif (index(c_line(1:icom),'INDIVIDUAL:') .ne. 0) then
    call sic_upper(c_line(1:icom))
    if (l_snam .ne. 0 .and. l_slam.ne.0 .and. l_sbet.ne.0) then
      !	if (l_snam .ne. 0) then
      call output_line(olun,error)
      if(error) goto 98
      l_snam = 0
    endif
    if(error) return
    i_sbas = index(c_line(1:icom),'SBAS').ne.0
    i_seqn = index(c_line(1:icom),'SEQN').ne.0
    i_slam = index(c_line(1:icom),'SLAM').ne.0
    i_sbet = index(c_line(1:icom),'SBET').ne.0
    i_vhel = index(c_line(1:icom),'VHEL').ne.0
    i_vlsr = index(c_line(1:icom),'VLSR').ne.0
    i_flux = index(c_line(1:icom),'FLUX').ne.0
    goto 100
  else
    call sic_upper(c_line(1:icom))
    call getpar(c_line(1:icom),'SNAM',c_snam_t,l_snam_t)
    !
    !  New source is defined
    if (l_snam_t .ne.0) then
      ! if (l_snam .ne. 0) then
      if (l_snam .ne. 0 .and. l_slam.ne.0 .and. l_sbet.ne.0) then
        call output_line(olun,error)
        if(error) goto 98
      endif
      l_snam = l_snam_t
      c_snam(1:l_snam) = c_snam_t(1:l_snam_t)
    endif
    if (i_sbas) call getpar(c_line(1:icom),'SBAS',c_sbas,l_sbas)
    if (i_seqn) call getpar(c_line(1:icom),'SEQN',c_seqn,l_seqn)
    if (i_slam) call getpar(c_line(1:icom),'SLAM',c_slam,l_slam)
    if (i_sbet) call getpar(c_line(1:icom),'SBET',c_sbet,l_sbet)
    if (i_vhel) call getpar(c_line(1:icom),'VHEL',c_vhel,l_vhel)
    if (i_vlsr) call getpar(c_line(1:icom),'VLSR',c_vlsr,l_vlsr)
    if (i_flux) call getpar(c_line(1:icom),'FLUX',c_flux,l_flux)
    goto 100
  endif
  !
98 call astro_message(seve%r,rname,'Input: '//c_line(1:nlu))
  !
997 close (unit=olun)
    call sic_frelun (olun)
  !
998 close (unit=lun)
    call sic_frelun (lun)
  !
end subroutine format_catalog
!
subroutine getpar(line,code,par,lpar)
  !---------------------------------------------------------------------
  ! @ private
  ! Find parameter par for code word CODE
  !---------------------------------------------------------------------
  character(len=*):: line           !
  character(len=*):: code           !
  character(len=*):: par            !
  integer(kind=4) :: lpar           !
  ! Global
  integer(kind=4) :: lenc
  ! Local
  integer(kind=4) :: i, j, j1, j2, ll
  ! Code ------------------------------------------------------------------
  lpar = 0
  par = ' '
  ll = lenc(line)
  i = index(line,code)
  if (i.eq.0) return
  i = i+len(code)
  if (i.gt.ll) goto 100
  j1 = index(line(i:),'=')
  j2 = index(line(i:),':')
  if (j1.ne.0) then
    i = i+j1
  elseif (j2.ne.0) then
    i = i+j2
  endif
  if (i.gt.ll) goto 100
  j = index(line(i:),';')-1
  if (j.eq.-1) j = lenc(line(i:))
  lpar = j
  if (lpar.ne.0) par(1:lpar) = line(i:i+lpar-1)
  return
  !
  100   lpar = 0
  return
end subroutine getpar
!
subroutine nblank(par,lpar)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*):: par            !
  integer(kind=4) :: lpar           !
  ! Local
  character(len=1) :: tab
  integer(kind=4) :: i, j
  tab = char(9)
  !
  call sic_blanc(par,lpar)
  j = 0
  do i=1, lpar
    if (par(i:i).ne.' ' .and. par(i:i).ne.tab) then
      j = j + 1
      par(j:j) = par(i:i)
    endif
  enddo
  lpar = j
  return
end subroutine nblank
!
subroutine transform(in,out,u,error)
  use gbl_message
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*):: in             !
  character(len=*):: out            !
  character(len=1) :: u             !
  logical :: error                  !
  ! Local
  integer(kind=4) :: iret, iang, iangin, lin
  real(kind=8) :: dang
  character(len=9) :: rname
  data rname /'TRANSFORM'/
  ! Code ------------------------------------------------------------------------
  lin = lenc(in)
  if (lin.le.0) then
    call astro_message(seve%e,rname,'null chain')
    error = .true.
    return
  endif
  call sic_blanc(in,lin)
  iret = iangin(in(1:lin),u,dang,iang)
  error = iret.ne.1
  if (error) then
    call astro_message(seve%e,rname,'error in IANGIN')
    return
  endif
  if (u.eq.'S') then
    call rad2sexa(dang,24,out,4,left=.true.)
  else
    call rad2sexa(dang,360,out,3,left=.true.)
  endif
end subroutine transform
!
subroutine output_line(olun,error)
  use gbl_message
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=4) :: olun           !
  logical :: error                  !
  ! Local
  character(len=80) :: c_sbas,c_seqn,c_slam,c_sbet,c_vhel,c_vlsr,c_snam
  character(len=80) :: c_flux
  integer(kind=4) :: l_sbas,l_seqn,l_slam,l_sbet,l_vhel,l_vlsr,l_snam,l_flux
  logical :: i_sbas,i_seqn,i_slam,i_sbet,i_vhel,i_vlsr,i_flux
  common /source_infc/ c_sbas,c_seqn,c_slam,c_sbet,c_vhel,c_vlsr,c_snam,c_flux
  common /source_infi/ l_sbas,l_seqn,l_slam,l_sbet,l_vhel,l_vlsr,l_snam,  &
                l_flux,i_sbas,i_seqn,i_slam,i_sbet,i_vhel,i_vlsr,i_flux
  character(len=132) :: o_line
  integer(kind=4) :: ko, sbas, lpar, npar
  character(len=12) :: par
  ! Code ------------------------------------------------------------------
  call sic_blanc(c_snam,l_snam)
  npar = 1
  lpar = 12
  ko = 1
  call sic_next(c_snam(1:l_snam),par,lpar,npar)
  lpar = min(12,lpar)
  o_line(ko:) = par(1:lpar)
  ko = ko + lpar
  if (ko.lt.7) then
    call sic_next(c_snam(npar:),par,lpar,npar)
    if (lpar.le.6 .and. lpar.gt.0) then
      o_line(ko:) = par(1:lpar)
      ko = ko + lpar
    endif
  endif
  ko = 15
  !
  ! Coordinate system
  if (l_sbas.gt.0) then
    call nblank(c_sbas,l_sbas)
    read(c_sbas(1:l_sbas),*,err=98) sbas
  else
    sbas = 1
  endif
  call nblank(c_seqn,l_seqn)
  if (sbas.eq.-1) then
    o_line (ko:) = 'EQ 2000'
    ko = ko + 7
  elseif (sbas.eq.0) then
    o_line(ko:) = 'GA'
    ko = ko + 2
  elseif (sbas.eq.1) then
    o_line(ko:) = ' '          ! EQ 1950 default
  elseif (sbas.eq.2) then
    if (l_seqn.eq.0) goto 98
    o_line(ko:) = 'EQ '//c_seqn
    ko = ko + 2 + l_seqn
  elseif (sbas.eq.3) then
    o_line(ko:) = 'DA'
    ko = ko + 2
  elseif (sbas.eq.6) then
    o_line (ko:) = 'EC 1950'
    ko = ko + 7
  elseif (sbas.eq.7) then
    if (l_seqn.eq.0) goto 98
    o_line(ko:) = 'EC '//c_seqn
    ko = ko + l_seqn
  elseif (sbas.eq.10) then
    o_line(ko:) = 'HO'
    ko = ko + 2
  else
    write (6,*) 'sbas = ',sbas
    goto 98
  endif
  ko = max(ko+1, 25)
  !
  ! Lambda, Beta
  if (sbas.eq.0 .or. sbas.eq.10) then
    call transform(c_slam,o_line(ko:),'"',error)
  else
    call transform(c_slam,o_line(ko:),'S',error)
  endif
  ko = ko + 15
  if (error) goto 98
  call transform(c_sbet,o_line(ko:),'"',error)
  ko = ko + 15
  if (error) goto 98
  !
  ! Velocity
  if (l_vlsr.ne.0) then
    call nblank(c_vlsr,l_vlsr)
    o_line(ko:) = 'LS '//c_vlsr(1:l_vlsr)
    ko = ko + 3 + l_vlsr
  elseif (l_vhel.ne.0) then
    call nblank(c_vhel,l_vhel)
    o_line(ko:) = 'HE '//c_vhel(1:l_vhel)
    ko = ko + 3 + l_vhel
  else
    o_line(ko:) = 'HE 0'
    ko = ko + 4
  endif
  !
  ! Flux
  if (l_flux .ne. 0) then
    call nblank(c_flux,l_flux)
    o_line(ko:) = ' FL '//c_flux(1:l_flux)
    ko = ko + 4 + l_flux
  endif
  !
  write(olun,'(A)') o_line(1:ko-1)
  if (i_sbas) l_sbas = 0
  if (i_seqn) l_seqn = 0
  if (i_slam) l_slam = 0
  if (i_sbet) l_sbet = 0
  if (i_flux) l_flux = 0
  l_flux = 0
  if (i_vlsr) l_vlsr = 0
  if (i_vhel) l_vhel = 0
  return
  !
  98 call astro_message(seve%e,'FORMAT','Conversion error or unsupported '//  &
     'option')
  error = .true.
  return
end subroutine output_line
