subroutine class_print(set,line,error)
  use gildas_def
  use image_def
  use gbl_format
  use gbl_constant
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>class_print
  use class_setup_new
  use class_types
  use class_common
  use class_index
  !----------------------------------------------------------------------
  ! @ public
  ! ANALYSE Support routine for command
  !	ANALYSE\PRINT   FIT   [/OUTPUT filename]
  !			AREA    [V1 [V2 [V3 [...]]]]
  !			MOMENT  [V1 V2 [V3 V4 [...]]]
  !			CHANNEL Liste
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set    !
  character(len=*),    intent(in)    :: line   ! Input command line
  logical,             intent(inout) :: error  ! Output error flag
  ! Local
  character(len=*), parameter :: proc='PRINT'
  type(gildas) :: tbl
  real(kind=4), allocatable :: dtbl(:,:)
  logical :: table,file
  integer(kind=4), parameter :: maxarg=20
  integer(kind=entry_length) :: kx,kn,ksave
  integer(kind=4) :: i,jtmp,ido,ic,iv,nv,ndata
  real(kind=4) :: kanal(maxarg),rchan1,rchan2,frac1,frac2
  integer(kind=4) :: cl(maxarg),ier,nc,tbl_dim2,ichan1,ichan2,istart,iend
  character(len=message_length) ::  mess
  character(len=filename_length) :: fich,name,tempo
  real(kind=4) :: off1,off2,aa
  real(kind=4), allocatable :: value(:)
  real(kind=4) :: area(maxarg),vites(maxarg),s0(maxarg),s1(maxarg),s2(maxarg)
  character(len=9) :: what,argum
  type(observation) :: obs
  ! Actions
  integer(kind=4), parameter :: mact=6
  character(len=8) :: action(mact)
  data action/'FIT','AREA','CHANNEL','MOMENT','POINTING','FLUX'/
  integer(kind=4), parameter :: dofit=1
  integer(kind=4), parameter :: doarea=2  ! PRINT AREA V1 V2 ...
  integer(kind=4), parameter :: doareabase=-2  ! PRINT AREA (no arg)
  integer(kind=4), parameter :: dochannel=3
  integer(kind=4), parameter :: domoment=4
  integer(kind=4), parameter :: dopointing=5
  integer(kind=4), parameter :: doflux=6
  !
  ! Verify if any input file
  if (.not.filein_opened(proc,error))  return
  !
  ! What is to be printed ?
  !
  table = sic_present(2,0)
  file = sic_present(1,0)
  if (table.and.file) then
     call class_message(seve%e,proc,'Conflicting option /FILE and /TABLE')
     error = .true.
     return
  endif
  !
  argum = 'FIT'
  call sic_ke (line,0,1,argum,nc,.false.,error)
  if (error) return
  call sic_ambigs('PRINT',argum,what,ido,action,mact,error)
  if (error) return
  !
  if (ido.eq.dofit .or. ido.ge.dopointing .or. ido.eq.doflux) then
     ! PRINT FIT|POINTING|FLUX
     if (table) then
        call class_message(seve%e,proc,  &
          'Option /TABLE is not available for PRINT '//action(ido))
        error = .true.
        return
     endif
  elseif (ido.eq.doarea) then
     ! PRINT AREA
     if (sic_narg(0).eq.1) then
        ! Baseline area
        ido = doareabase
        tbl_dim2 = 5
     elseif (sic_narg(0).eq.2) then
        call class_message(seve%e,proc,'At least 2 velocities needed (1 range)')
        error = .true.
        return
     else
        ! Decode area velocity list
        istart = sic_start(0,2)
        iend = sic_end(0,sic_narg(0))
        call sic_build_listr4(vites,nv,maxarg,line(istart:iend),proc,error)
        if (error) return
        tbl_dim2 = 3+nv-1  ! num + x + y + (nv-1) ranges
     endif
  elseif (ido.eq.dochannel) then
     ! PRINT CHANNEL: decode channel list
     if (sic_narg(0).le.1) then
        call class_message(seve%e,proc,'Missing channel list')
        error = .true.
        return
     endif
     istart = sic_start(0,2)
     iend = sic_end(0,sic_narg(0))
     call sic_build_listi4(cl,nv,maxarg,line(istart:iend),proc,error)
     if (error) return
     tbl_dim2 = 3+nv
  elseif (ido.eq.domoment) then
     ! PRINT MOMENT: decode moment velocity list
     if (sic_narg(0).le.2) then
        call class_message(seve%e,proc,'At least 2 velocities needed (1 range)')
        error = .true.
        return
     endif
     istart = sic_start(0,2)
     iend = sic_end(0,sic_narg(0))
     call sic_build_listr4(vites,nv,maxarg,line(istart:iend),proc,error)
     if (error) return
     nv = nv/2  ! Nv values => Nv pairs
     tbl_dim2 = 3+3*nv
  endif
  !
  ! Open output file if needed
  if (file) then
     call sic_ch (line,1,1,name,nc,.true.,error)
     if (error) return
     ier = sic_getlun(jtmp)
     if (ier.ne.1) then
        call class_message(seve%e,proc,'No logical unit left')
        error = .true.
        return
     endif
     call sic_parse_file(name,' ','.dat',fich)
     ier = sic_open(jtmp,fich,'NEW',.false.)
     if (ier.ne.0) then
        call class_message(seve%e,proc,'Unable to open file '//name)
        call putios ('          ',ier)
        error = .true.
        call sic_frelun(jtmp)
        return
     endif
     tempo = ' '
     call sic_date(tempo)
     write (jtmp,'("!",/,"! ",A)') trim(tempo)
     inquire (unit=filein%lun,name=tempo)
     write (jtmp,'("! Input file  : ",a)') trim(tempo)
     write (jtmp,'("! Input command: ",a,/,"!")') trim(line)
     !
  elseif (table) then
     ! TABLE output
     call sic_ch (line,2,1,name,nc,.true.,error)
     if (error) return
     mess = 'Creating Table '//name
     call class_message(seve%i,proc,mess)
     call gildas_null(tbl)
     tbl%file = name
     tbl%gil%dim(1) = cx%next-1
     tbl%gil%dim(2) = tbl_dim2
     tbl%gil%coor_words = 0
     tbl%gil%ndim = 2
     allocate(dtbl(tbl%gil%dim(1),tbl%gil%dim(2)),stat=ier)
  else
     ! STDOUT
     jtmp = 6
  endif
  !
  call init_obs(obs)
  !
  ! Call appropriate routine according to what to do
  if (ido.eq.dofit) then  ! PRINT FIT
     if (set%method.eq.'CONTINUUM' .or. set%method.eq.'BASECONT') then
        call pricont(set,jtmp)
     elseif (set%method.eq.'GAUSS') then
        call prigauss(set,jtmp)
     elseif (set%method.eq.'NH3'.or.set%method.eq.'HFS') then
        call prinh3(set,jtmp)
     elseif (set%method.eq.'ABSORPTION') then
        call priabs(set,jtmp)
     elseif (set%method.eq.'SHELL') then
        call prishell(set,jtmp)
     endif
  elseif (ido.eq.dopointing) then  ! PRINT POINTING
     call pripoint(set,jtmp)
  elseif (ido.eq.doflux) then  ! PRINT FLUX
     call priflux(set,jtmp)
  else
     !
     ksave = knext
     !
     do kn=1,cx%next-1
        kx = cx%ind(kn)
        !
        ! Read the observation into obs
        call robs(obs,kx,error)        ! read obs header
        if (sic_ctrlc() .and. jtmp.eq.6) exit
        if (error) exit
        call rgen(set,obs,error)           ! general informations
        error = .false.
        if (ido.eq.doareabase) then
           if (.not.obs%head%presec(class_sec_bas_id)) then
             write(mess,'(3(A,I0))')  'Observation ',obs%head%gen%num,';',  &
               obs%head%gen%ver,' has no BASE section. Skipping.'
             call class_message(seve%w,proc,mess)
             cycle
           endif
           call rbase(set,obs,error)
           if (error) then
              write(mess,1002) kx,obs%head%gen%num,obs%head%gen%ver
              call class_message(seve%w,proc,mess)
           elseif (table) then
              ! call cido00 (obs%head%gen%num,head%pos%lamof,head%pos%betof,  &
              !              obs%head%bas%aire,obs%head%bas%sigfi,              &
              !              kn,dtbl,tbl%gil%dim(1),tbl%gil%dim(2))
              dtbl(kn,1) = obs%head%gen%num
              dtbl(kn,2) = obs%head%pos%lamof
              dtbl(kn,3) = obs%head%pos%betof
              dtbl(kn,4) = obs%head%bas%aire
              dtbl(kn,5) = obs%head%bas%sigfi
           else
              off1 = obs%head%pos%lamof*class_setup_get_fangle()
              off2 = obs%head%pos%betof*class_setup_get_fangle()
              write (jtmp,1003) obs%head%gen%num,off1,off2,obs%head%bas%aire,obs%head%bas%sigfi
           endif
           !
           ! List of channels
        elseif (ido.eq.dochannel) then
           call rspec(set,obs,error)
           ndata = obs%head%spe%nchan
           call reallocate_obs(obs,ndata,error)
           if (error)  return
           call rdata(set,obs,ndata,obs%spectre,error)
           if (error)  return
           allocate(value(ndata))  ! Not very efficient, but Ndata can vary for
                                   ! each observation in the index
           do i=1,nv
              if (cl(i).ge.1 .and. cl(i).le.ndata) then
                 value(i) = obs%spectre( cl(i) )
              else
                 value(i) = obs%head%spe%bad
              endif
           enddo
           if (table) then
              ! call cido03 (obs%head%gen%num,obs%head%pos%lamof,obs%head%pos%betof,  &
              !              nv,value,kn,dtbl,tbl%gil%dim(1),tbl%gil%dim(2))
              dtbl(kn,1) = obs%head%gen%num
              dtbl(kn,2) = obs%head%pos%lamof
              dtbl(kn,3) = obs%head%pos%betof
              do iv=1,nv
                 dtbl(kn,3+iv) = value(iv)
              enddo
           else
              off1 = obs%head%pos%lamof*class_setup_get_fangle()
              off2 = obs%head%pos%betof*class_setup_get_fangle()
              write (jtmp,1005) obs%head%gen%num,off1,off2,(value(i),i=1,nv)
           endif
           deallocate(value)
           !
        elseif (ido.eq.domoment) then
           call rspec(set,obs,error)
           ndata = obs%head%spe%nchan
           call reallocate_obs(obs,ndata,error)
           if (error)  return
           call rdata(set,obs,ndata,obs%spectre,error)
           do iv = 1, nv
              call getmom(obs,vites(2*iv-1),vites(2*iv),s0(iv),s1(iv),s2(iv))
           enddo
           if (table) then
              ! call cido04(obs%head%gen%num,obs%head%pos%lamof,obs%head%pos%betof,  &
              !             nv,s0,s1,s2,kn,dtbl,tbl%gil%dim(1),tbl%gil%dim(2))
              dtbl(kn,1) = obs%head%gen%num
              dtbl(kn,2) = obs%head%pos%lamof
              dtbl(kn,3) = obs%head%pos%betof
              do iv=1,nv
                 dtbl(kn,3+iv) = s0(iv)
                 dtbl(kn,3+nv+iv) = s1(iv)
                 dtbl(kn,3+2*nv+iv) = s2(iv)
              enddo
           else
              off1 = obs%head%pos%lamof*class_setup_get_fangle()
              off2 = obs%head%pos%betof*class_setup_get_fangle()
              write (jtmp,1005) obs%head%gen%num,off1,off2, &
                   &          (s0(iv),s1(iv),s2(iv),iv=1,nv)
           endif
           !
           ! Area by velocity range
        elseif (ido.eq.doarea) then
           !
           ! Compute the boundary channels
           call rspec(set,obs,error)
           ndata = obs%head%spe%nchan
           call reallocate_obs(obs,ndata,error)
           if (error)  return
           call rdata(set,obs,ndata,obs%spectre,error)
           do iv=1,nv
             call abscissa_velo2chan(obs%head,vites(iv),kanal(iv))
           enddo
           !
           ! Compute the area
           do iv = 1,nv-1
              ! Channels (real values)
              if (kanal(iv).lt.kanal(iv+1)) then
                rchan1 = kanal(iv)
                rchan2 = kanal(iv+1)
              else
                rchan1 = kanal(iv+1)
                rchan2 = kanal(iv)
              endif
              !
              ! Protections
              if (rchan2.lt..5 .or. rchan1.gt.(ndata+.5)) then
                write(mess,*) 'Velocity range ',vites(iv),vites(iv+1),  &
                  ' is out of spectrum boundaries'
                call class_message(seve%e,proc,mess)
                error = .true.
                goto 10
              endif
              !
              ! Channels (integer values)
              ichan1 = nint(rchan1)  ! because e.g. channel #2 goes from 1.5 to 2.5
              ichan2 = nint(rchan2)
              !
              ! Protections
              if (rchan1.lt..5 .or. rchan2.gt.(ndata+.5)) then
                write(mess,*) 'Velocity range ',vites(iv),vites(iv+1),  &
                  ' intersects spectrum boundaries'
                call class_message(seve%w,proc,mess)
                if (rchan1.lt..5)  then
                  rchan1 = .5
                  ichan1 = 1
                endif
                if (rchan2.gt.(ndata+.5))  then
                  rchan2 = ndata+.5
                  ichan2 = ndata
                endif
              endif
              !
              ! Boundary channel fractions
              if (ichan1.eq.ichan2) then
                frac1 = rchan2-rchan1
                frac2 = 0.
              else
                frac1 = (real(ichan1)+.5)-rchan1
                frac2 = rchan2-(real(ichan2)-.5)
              endif
              !
              ! Integrate
              aa = frac1*obs_good(obs,ichan1)
              do ic=ichan1+1,ichan2-1
                aa = aa + obs_good(obs,ic)  ! 'obs_good' interpolates bad channels if any
              enddo
              aa = aa + frac2*obs_good(obs,ichan2)
              !
              area(iv) = aa*abs(obs%head%spe%vres)
           enddo
           !
           if (table) then
              ! call cido03(obs%head%gen%num,obs%head%pos%lamof,obs%head%pos%betof,  &
              !             nv,area,kn,dtbl,tbl%gil%dim(1),tbl%gil%dim(2))
              dtbl(kn,1) = obs%head%gen%num
              dtbl(kn,2) = obs%head%pos%lamof
              dtbl(kn,3) = obs%head%pos%betof
              do iv=1,nv-1
                 dtbl(kn,3+iv) = area(iv)
              enddo
           else
              off1 = obs%head%pos%lamof*class_setup_get_fangle()
              off2 = obs%head%pos%betof*class_setup_get_fangle()
              write (jtmp,1005) obs%head%gen%num,off1,off2,(area(i),i=1,nv-1)
           endif
        endif
        error = .false.
        !
        ! Loop over index
     enddo
     !
     knext = ksave
  endif
  !
  if (table)  call gdf_write_image(tbl,dtbl,error)
  !
10 continue  ! You can jump here in case of error
  !
  call free_obs(obs)
  if (table) then
     deallocate(dtbl,stat=ier)
  elseif (jtmp.ne.6) then
     close (jtmp)
     call sic_frelun(jtmp)
  endif
  return
  !
1002 format('At entry ',i0,' Scan ',i0,';',i0)
1003 format(1x,i0,2(2x,f9.3),2x,(f9.3,1x,f6.3))
! 1004 format(1x,i0,11(2x,f9.3))
1005 format(1x,i0,2(2x,f9.3),15(1x,1pg12.5))
end subroutine class_print
!
subroutine getmom(obs,v1,v2,aire,vit,del)
  use gildas_def
  use gbl_constant
  use classcore_interfaces, except_this=>getmom
  use class_types
  !----------------------------------------------------------------------
  ! @ private
  ! Computes moment of the data between V1 and V2
  ! Caution: V1 and V2 are rounded to the nearest channel
  !----------------------------------------------------------------------
  type(observation), intent(in)  :: obs   !
  real(kind=4),      intent(in)  :: v1    ! Lower bound
  real(kind=4),      intent(in)  :: v2    ! Upper bound
  real(kind=4),      intent(out) :: aire  ! Integrated area
  real(kind=4),      intent(out) :: vit   ! Central velocity
  real(kind=4),      intent(out) :: del   ! Line width
  ! Local
  real(kind=4) :: s0, s1, s2, value, s12, r1, r2
  integer(kind=4) :: i1, i2, nc, imin, imax, i
  !
  ! Compute the moment(s)
  if (obs%head%gen%kind.eq.kind_spec) then
    call abscissa_velo2chan(obs%head,v1,r1)
    call abscissa_velo2chan(obs%head,v2,r2)
    i1 = nint(r1)
    i2 = nint(r2)
    nc = obs%head%spe%nchan
  else
    call abscissa_angl2chan(obs%head,v1,r1)
    call abscissa_angl2chan(obs%head,v2,r2)
    i1 = nint(r1)
    i2 = nint(r2)
    nc = obs%head%dri%npoin
  endif
  imin = max(min(i1,i2),1)
  imax = min(max(i1,i2),nc)
  !
  s0 = 0.
  s1 = 0.
  s2 = 0.
  aire = 0.
  vit = 0.
  del = 0.
  do i=imin,imax
    value = obs_good(obs,i)
    s0 = s0+value
    s1 = s1+value*i
    s2 = s2+i*value*i
  enddo
  !
  ! Type out result according to Kind
  if (obs%head%gen%kind.eq.kind_spec) then
    if (s0.ne.0) then
      s1 = s1 / s0
      call abscissa_chan2velo(obs%head,s1,vit)
      s2 = s2 / s0
      s12 = s1**2
      if (s2.gt.s12)  del = abs(obs%head%spe%vres) * sqrt((s2-s12)*8.*log(2.))
    endif
    aire = s0 * abs(obs%head%spe%vres)
  else
    if (s0.ne.0) then
      s1 = s1 / s0
      call abscissa_chan2angl(obs%head,s1,vit)
      s2 = s2 / s0
      s12 = s1**2
      if (s2.gt.s12)  del = abs(obs%head%dri%ares) * sqrt((s2-s12)*8.*log(2.))
    endif
    aire = s0 * abs (obs%head%dri%ares)
  endif
end subroutine getmom
!
subroutine prigauss(set,jtmp)
  use gbl_constant
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>prigauss
  use class_setup_new
  use class_types
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  !  Print the results of gaussfit to a listing file
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set   !
  integer(kind=4),     intent(in) :: jtmp  ! Logical unit number
  ! Local
  integer(kind=4) :: k,i
  integer(kind=entry_length) :: ksave,kn
  real(kind=4) :: off1,off2
  logical :: error
  type(observation) :: obs
  !
  call init_obs(obs)
  !
  ksave = knext
  !
  ! Loop over index
  do kn=1,cx%next-1
     ! Read the observation into obs
     call robs(obs,cx%ind(kn),error)
     if (sic_ctrlc().and.(jtmp.eq.6)) exit
     error=.false.
     call rgen(set,obs,error)
     error=.false.
     call rgaus(set,obs,error)
     off1 = obs%head%pos%lamof*class_setup_get_fangle()
     off2 = obs%head%pos%betof*class_setup_get_fangle()
     !
     ! Write the information if present
     if (obs%head%gau%sigba.ne.0.0.and..not.error) then
        k=1
        if (obs%head%gen%kind.eq.kind_cont) then
           do i=1,max(obs%head%gau%nline,1)
              write (jtmp,1000)  &
                max(obs%head%gau%nline,1),obs%head%gen%num,  &
                off1,off2,                                   &
                obs%head%gau%nfit(k)*class_setup_get_fangle(),  &
                obs%head%gau%nerr(k)*class_setup_get_fangle(),  &
                obs%head%gau%nfit(k+1)*class_setup_get_fangle(),  &
                obs%head%gau%nerr(k+1)*class_setup_get_fangle(),  &
                obs%head%gau%nfit(k+2)*class_setup_get_fangle(),  &
                obs%head%gau%nerr(k+2)*class_setup_get_fangle(),  &
                obs%head%gau%nfit(k)/obs%head%gau%nfit(k+2)/1.064467,  &
                obs%head%gau%sigba,obs%head%gau%sigra
              k=k+3
           enddo
        else
           do i=1,max(obs%head%gau%nline,1)
              write (jtmp,1000) max(obs%head%gau%nline,1),             &
                obs%head%gen%num,off1,off2,                            &
                obs%head%gau%nfit(k),  obs%head%gau%nerr(k),           &
                obs%head%gau%nfit(k+1),obs%head%gau%nerr(k+1),         &
                obs%head%gau%nfit(k+2),obs%head%gau%nerr(k+2),         &
                obs%head%gau%nfit(k)/obs%head%gau%nfit(k+2)/1.064467,  &
                obs%head%gau%sigba,obs%head%gau%sigra
              k=k+3
           enddo
        endif
     else
        write(jtmp,1002) 0,obs%head%gen%num,off1,off2
     endif
     error = .false.
  enddo
  knext = ksave
  !
  call free_obs(obs)
  return
  !
1000 format(1x,i1,1x,i0,2(1x,g10.3),2x,   &
       &    3(1pg12.4,' ',1pg11.3,'   '),1pg11.3,2x,2(1pg11.3,2x))
! 1001 format(35x,   &
!        &    3(1pg12.4,' ',1pg11.3,'   '),1pg11.3,2x,2(1pg11.3,2x))
1002 format(1x,i1,1x,i0,2(2x,f8.3),2x,'/   No Fit ...')
end subroutine prigauss
!
subroutine priabs(set,jtmp)
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>priabs
  use class_setup_new
  use class_types
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  ! Print the ABS fit results in a format suitable for GREG
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set
  integer(kind=4),     intent(in) :: jtmp
  ! Local
  integer(kind=4) :: k,i
  integer(kind=entry_length) :: ksave,kn
  real(kind=4) :: off1,off2
  logical :: error
  type(observation) :: obs
  !
  call init_obs(obs)
  !
  write (jtmp,1003)
  ksave=knext
  !
  ! Loop over index entries
  do kn=1,cx%next-1
     ! Read the observation into obs
     call robs(obs,cx%ind(kn),error)
     if (sic_ctrlc().and.(jtmp.eq.6)) exit
     error=.false.
     off1 = obs%head%pos%lamof*class_setup_get_fangle()
     off2 = obs%head%pos%betof*class_setup_get_fangle()
     if (obs%head%presec(class_sec_abs_id)) then
        call rgen(set,obs,error)
        error=.false.
        call rabs(set,obs,error)
        k=2
        do i=1,max(obs%head%abs%nline,1)
           write (jtmp,1000)                                 &
             max(obs%head%abs%nline,1),obs%head%gen%num,     &
             off1,off2,                                      &
             obs%head%abs%nfit(k),  obs%head%abs%nerr(k),    &
             obs%head%abs%nfit(k+1),obs%head%abs%nerr(k+1),  &
             obs%head%abs%nfit(k+2),obs%head%abs%nerr(k+2),  &
             obs%head%abs%sigba,    obs%head%abs%sigra
           k=k+3
        enddo
        error = .false.
     endif
  enddo
  knext=ksave
  !
  call free_obs(obs)
  return
  !
1000 format(1x,i1,1x,i0,2(2x,f8.3),2x,  &
            3(f8.3,' ',f7.3,'   '),2x,2(f6.3,2x))
1003 format('! Absorption fitting . . . . . . . . . .',  &
            'Opacity           Vlsr            Width ')
end subroutine priabs
!
subroutine prishell(set,jtmp)
  use phys_const
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>prishell
  use class_setup_new
  use class_types
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  !  Print the SHELL fit results in a format suitable for GREG
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set   !
  integer(kind=4),     intent(in) :: jtmp  ! Logical Unit number for message
  ! Local
  integer(kind=entry_length) :: kn,ksave
  integer(kind=4) :: k,i
  real(kind=4) :: off1,off2, d, ed
  real(kind=8) :: f ,fi
  logical :: error
  type(observation) :: obs
  !
  call init_obs(obs)
  !
  write (jtmp,1003)
  ksave=knext
  !
  ! Loop over index entries
  do kn=1,cx%next-1
     ! Read the observation into obs
     call robs(obs,cx%ind(kn),error)
     if (sic_ctrlc().and.(jtmp.eq.6)) exit
     error=.false.
     off1 = obs%head%pos%lamof*class_setup_get_fangle()
     off2 = obs%head%pos%betof*class_setup_get_fangle()
     if (obs%head%presec(class_sec_she_id)) then
        call rgen(set,obs,error)
        error=.false.
        call rshel(set,obs,error)
        error=.false.
        call rspec(set,obs,error)
        k=1
        f = obs%head%she%nfit(k+1)+obs%head%spe%restf
        fi=-obs%head%she%nfit(k+1)+obs%head%spe%image
        d = obs%head%she%nfit(k+2)*clight_kms/obs%head%spe%restf
        ed= obs%head%she%nerr(k+2)*clight_kms/obs%head%spe%restf
        ! T = 1.5*obs%head%she%nfit(K)/obs%head%she%nfit(K+2)/(3.0+obs%head%she%nfit(K+3))
        write (jtmp,1000)  &
          max(obs%head%she%nline,1),obs%head%gen%num,off1,off2,            &
          obs%head%she%nfit(k), obs%head%she%nerr(k), f, fi,               &
          obs%head%she%nerr(k+1), d, ed,  obs%head%she%nfit(k+3),          &
          obs%head%she%nerr(k+3), obs%head%she%sigba, obs%head%she%sigra,  &
          obs%head%pos%sourc
        !
        ! Write the information if present
        do i=2,max(obs%head%she%nline,1)
           k=k+4
           f = obs%head%she%nfit(k+1)+obs%head%spe%restf
           fi=-obs%head%she%nfit(k+1)+obs%head%spe%image
           d = obs%head%she%nfit(k+2)*clight_kms/obs%head%spe%restf
           ed= obs%head%she%nerr(k+2)*clight_kms/obs%head%spe%restf
           write (jtmp,1001)  &
             obs%head%she%nfit(k),obs%head%she%nerr(k),  &
             f,fi,obs%head%she%nerr(k+1),                &
             d,ed,obs%head%she%nfit(k+3),obs%head%she%nerr(k+3)
        enddo
        error = .false.
     else
        write(jtmp,1002) 0,obs%head%gen%num,off1,off2,obs%head%pos%sourc
     endif
     !
  enddo
  knext=ksave
  !
  call free_obs(obs)
  return
  !
1003 format('! Shell Scan   Off1     Off2     Area     Da      ',   &
            'Freq.Sig.    Freq.Ima.    Df    Exp.Vel.   De  Horn/Center ',   &
            'DH/C  Sig.B.  Sig.R.')
1000 format (1x,i1,1x,i0,2(1x,f8.3),1x,   &
            f8.3,1x,f7.3,1x,2(f12.3,1x),f7.3,1x,   &
            2(f8.2,1x,f6.2,1x),2(f7.3,1x),'/',a)
1001 format (30x,   &
            f8.3,1x,f7.3,1x,2(f12.3,1x),f7.3,1x,   &
            2(f8.2,1x,f6.2,1x))
1002 format (1x,i1,1x,i0,2(2x,f8.3),2x,'/ ',a,' No Fit ...')
end subroutine prishell
!
subroutine prinh3(set,jtmp)
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>prinh3
  use class_setup_new
  use class_types
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  ! Print the NH3 fit results in a format suitable for GREG
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set
  integer(kind=4),     intent(in) :: jtmp
  ! Local
  integer(kind=entry_length) :: kn,ksave
  integer(kind=4) :: k,i
  real(kind=4) :: off1,off2
  logical :: error
  type(observation) :: obs
  !
  call init_obs(obs)
  !
  write (jtmp,1003)
  ksave=knext
  !
  ! Loop over index entries
  do kn=1,cx%next-1
     ! Read the observation into obs
     call robs(obs,cx%ind(kn),error)
     if (sic_ctrlc().and.(jtmp.eq.6)) exit
     error=.false.
     off1 = obs%head%pos%lamof*class_setup_get_fangle()
     off2 = obs%head%pos%betof*class_setup_get_fangle()
     if (obs%head%presec(class_sec_hfs_id)) then
        call rgen(set,obs,error)
        error=.false.
        call rnh3(set,obs,error)
        k=1
        do i=1,max(obs%head%hfs%nline,1)
           write (jtmp,1000)  &
             max(obs%head%hfs%nline,1),obs%head%gen%num,     &
             off1,off2,                                      &
             obs%head%hfs%nfit(k),  obs%head%hfs%nerr(k),    &
             obs%head%hfs%nfit(k+1),obs%head%hfs%nerr(k+1),  &
             obs%head%hfs%nfit(k+2),obs%head%hfs%nerr(k+2),  &
             obs%head%hfs%nfit(k+3),obs%head%hfs%nerr(k+3),  &
             obs%head%hfs%sigba,obs%head%hfs%sigra
           k=k+4
        enddo
        error = .false.
     endif
  enddo
  knext=ksave
  !
  call free_obs(obs)
  return
  !
1000 format(1x,i1,1x,i0,2(2x,f8.3),2x,  &
            4(f8.3,' ',f7.3,'   '),2x,2(f6.3,2x))
1003 format('! NH3 Hyperfine structure fitting . . . . . . . . . .',  &
            'Area           Vlsr            Width          Opacity')
end subroutine prinh3
!
subroutine pricont(set,jtmp)
  use phys_const
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>pricont
  use class_setup_new
  use class_types
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  !  Print the results of gaussfit to a listing file, for continuum data
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set   !
  integer(kind=4),     intent(in) :: jtmp  ! Logical unit number
  ! Local
  integer(kind=entry_length) :: kn,ksave
  integer(kind=4) :: k
  real(kind=4) :: off1,off2
  logical :: error
  type(observation) :: obs
  !
  call init_obs(obs)
  !
  write(jtmp,1001)
  ksave = knext
  !
  ! Loop over index
  do kn=1,cx%next-1
     ! Read the observation into obs
     call robs(obs,cx%ind(kn),error)
     if (sic_ctrlc().and.(jtmp.eq.6)) exit
     error=.false.
     call rgen(set,obs,error)
     error=.false.
     call rpoint(set,obs,error)
     off1 = obs%head%gen%az*180.0d0/pi
     off2 = obs%head%gen%el*180.0d0/pi
     !
     ! Write the information if present
     if (obs%head%poi%sigba.ne.0.0 .and. .not.error) then
        k = 3
        write (jtmp,1000)                                   &
          obs%head%gen%num,                                 &
          off1,off2,                                        &
          obs%head%poi%nfit(k)*class_setup_get_fangle(),    &
          obs%head%poi%nerr(k)*class_setup_get_fangle(),    &
          obs%head%poi%nfit(k+1)*class_setup_get_fangle(),  &
          obs%head%poi%nerr(k+1)*class_setup_get_fangle(),  &
          obs%head%poi%nfit(k+2)*class_setup_get_fangle(),  &
          obs%head%poi%nerr(k+2)*class_setup_get_fangle(),  &
          obs%head%poi%nfit(k)/obs%head%poi%nfit(k+2)/1.064467,  &
          obs%head%poi%sigba,obs%head%poi%sigra,                 &
          obs%head%pos%sourc
     else
        write (jtmp,1002) obs%head%gen%num,off1,off2,obs%head%pos%sourc
     endif
     error = .false.
  enddo
  knext = ksave
  !
  call free_obs(obs)
  return
  !
1001 format('!   Obs.#     Azimuth   Elevation   Area     ..',   &
            '            Position  ..           Width     ..          Intensity',  &
            '         Sigmas ..     Source')
1000 format(1x,i10,2(2x,g9.3),2x,   &
            3(g9.3,' ',g9.3,'   '),g9.3,4x,2(g9.3,2x),'''',a,'''')
1002 format(1x,i10,2(2x,g9.3),2x,'/   No Fit ... for ',a)
end subroutine pricont
!
subroutine pripoint(set,jtmp)
  use phys_const
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>pripoint
  use class_types
  use class_index
  !----------------------------------------------------------------------
  ! @ private
  !  Print the results of gaussfit to a listing file, for pointing data
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set
  integer(kind=4),     intent(in) :: jtmp   ! Logical unit number
  ! Local
  real(kind=8) :: kangle
  integer(kind=entry_length) :: kn,ksave
  integer(kind=4) :: k,iflag,iant,ista
  real(kind=4) :: az,el,time,offset
  logical :: error
  character(len=12) :: cteles
  type(observation) :: obs
  !
  call init_obs(obs)
  !
  write(jtmp,1001)
  ksave = knext
  kangle = 3600d0*180d0/pi
  !
  ! Loop over index
  do kn=1,cx%next-1
     ! Read the observation into obs
     call robs(obs,cx%ind(kn),error)
     error=.false.
     call rgen(set,obs,error)
     error=.false.
     call rcont(set,obs,error)
     error = .false.
     call rpoint(set,obs,error)
     az  = obs%head%gen%az*180.0d0/pi
     el = obs%head%gen%el*180.0d0/pi
     time = obs%head%gen%st*12.d0/pi
     !
     cteles = obs%head%gen%teles
     if (cteles(1:3).eq.'BUR') then
        read(cteles(4:4),'(I1)') iant
        read(cteles(7:8),'(I2)') ista
        if (cteles(6:6).eq.'E') then
           ista = 300+ista
        elseif (cteles(6:6).eq.'W') then
           ista = 200+ista
        elseif (cteles(6:6).eq.'N') then
           ista = 100+ista
        endif
     else
        iant = 0
        ista = 0
     endif
     !
     ! Write the information if present
     if (obs%head%poi%sigba.ne.0.0.and..not.error) then
        k = 3
        if (mod(abs(obs%head%dri%apos+pis),pis).le.1e-3 .or.   &
            mod(abs(obs%head%dri%apos),pis).le.1e-3) then
           iflag = 0                ! 0 or PI: along elevation
           offset = obs%head%dri%colle+obs%head%poi%nfit(k+1)+obs%head%pos%betof
        elseif (abs(mod(obs%head%dri%apos,pis)-0.5*pis).le.1e-3 .or.  &
                abs(mod(obs%head%dri%apos,pis)+0.5*pis).le.1e-3) then
           iflag = 1                ! -PI/2 or +PI/2: along azimuth
           offset = obs%head%dri%colla+obs%head%poi%nfit(k+1)+obs%head%pos%lamof
        else
           iflag = -1               ! Unknown
           offset = obs%head%poi%nfit(k+1)
        endif
        write (jtmp,1000)                                               &
          obs%head%gen%num,obs%head%gen%scan,iflag,az,el,time,          &
          offset*kangle,obs%head%poi%nerr(k+1)*kangle,iant,ista,        &
          obs%head%poi%nfit(k+2)*kangle,obs%head%poi%nerr(k+2)*kangle,  &
          obs%head%poi%nfit(k)/obs%head%poi%nfit(k+2)/1.064467,         &
          obs%head%poi%sigra,                                           &
          obs%head%pos%sourc
     else
        write (jtmp,1002) obs%head%gen%num,obs%head%gen%scan,-1,az,el,  &
          time,obs%head%pos%sourc
     endif
     error = .false.
  enddo
  knext = ksave
  !
  call free_obs(obs)
  return
  !
1001 format('!   Obs.#     Scan Code Azimuth   Elevation   Time  ',  &
            '     Position  ..  A# Station   Width      ..     Intensity',  &
            '     Sigma    Source')
1000 format(1x,i8,1x,i8,i4,3(2x,f8.3),1x,  &
            f9.2,1x,f8.2,1x,i2,i4,1x,f9.2,1x,f8.2,1x,  &
            1pg10.3,2x,1pg10.3,2x,'''',a,'''')
1002 format(1x,i8,1x,i8,i4,3(2x,f8.3),2x,'/   No Fit ... for ',a)
end subroutine pripoint
!
subroutine priflux(set,jtmp)
  use phys_const
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>priflux
  use class_index
  use class_types
  !----------------------------------------------------------------------
  ! @ private
  !  Print the results of gaussfit to a listing file, for FLUX data
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in) :: set
  integer(kind=4),     intent(in) :: jtmp   ! Logical unit number
  ! Local
  real(kind=8) :: kangle
  integer(kind=entry_length) :: kn,ksave
  integer(kind=4) :: k,iflag,iant,ista
  real(kind=4) :: az,el,time,offset
  logical :: error
  character(len=12) :: cteles,ch
  type(observation) :: obs
  !
  call init_obs(obs)
  !
  write(jtmp,1001)
  ksave = knext
  kangle = 3600d0*180d0/pi
  !
  ! Loop over index
  do kn=1,cx%next-1
     ! Read the observation into obs
     call robs(obs,cx%ind(kn),error)
     error=.false.
     call rgen(set,obs,error)
     error=.false.
     call rcont(set,obs,error)
     error = .false.
     call rcal(set,obs,error)
     error = .false.
     call rpoint(set,obs,error)
     error = .false.
     az  = obs%head%gen%az*180.0d0/pi
     el = obs%head%gen%el*180.0d0/pi
     time = obs%head%gen%st*12.d0/pi
     !
     cteles = obs%head%gen%teles
     if (cteles(1:3).eq.'BUR') then
        read(cteles(4:4),'(I1)') iant
     else
        iant = 0
        ista = 0
     endif
     !
     ! Write the information if present
     call gag_todate(obs%head%gen%dobs,ch,error)
     if (obs%head%poi%sigba.ne.0.0.and..not.error) then
        k = 3
        if (mod(abs(obs%head%dri%apos+pis),pis).le.1e-3 .or.   &
            mod(abs(obs%head%dri%apos),pis).le.1e-3) then
           iflag = 0                ! Elevation
           offset = obs%head%poi%nfit(k+1)+obs%head%pos%betof
        elseif (mod(abs(obs%head%dri%apos+0.5*pis),pis).le.1e-3) then
           iflag = 1                ! Azimuth
           offset = obs%head%poi%nfit(k+1)+obs%head%pos%lamof
        else
           iflag = -1               ! Unknown
           offset = obs%head%poi%nfit(k+1)
        endif
        write (jtmp,1000)                                               &
          obs%head%gen%num,obs%head%gen%scan,iflag,az,el,time,          &
          offset*kangle,obs%head%poi%nerr(k+1)*kangle,iant,             &
          obs%head%poi%nfit(k+2)*kangle,obs%head%poi%nerr(k+2)*kangle,  &
          obs%head%poi%nfit(k)/obs%head%poi%nfit(k+2)/1.064467,         &
          obs%head%poi%sigra,obs%head%cal%gaini,                        &
          obs%head%dri%freq*1e-3,obs%head%dri%cimag*1e-3,               &
          obs%head%pos%sourc,ch
     else
        write (jtmp,1000)  &
          obs%head%gen%num,obs%head%gen%scan,-1,az,el,time,obs%head%pos%sourc,ch
     endif
     error = .false.
  enddo
  knext = ksave
  !
  call free_obs(obs)
  return
  !
1001 format('!   Obs.#     Scan Code Azimuth   Elevation  Time  ',  &
            '     Position  ..  A#     Width      ..     Intensity',  &
            '     ..  Gain   Fsignal  Fimage Source  Date')
1000 format(1x,i8,1x,i8,i3,3(1x,f8.3),1x,  &
            f9.2,1x,f8.2,1x,i2,1x,f9.2,1x,f8.2,1x,  &
            1pg10.3,1x,1pg10.3,1x,0pf6.2,2(1x,f8.3),1x,'''',a,'''',  &
            1x,'''',a,'''')
end subroutine priflux
!
subroutine cido00 (num,off1,off2,aire,sigma,n,tab,nl,nc)
  !----------------------------------------------------------------------
  ! @ private
  ! CLASS Internal routine
  ! obsolete
  !----------------------------------------------------------------------
  integer, intent(in) :: num
  integer, intent(in) :: n
  integer, intent(in) :: nl
  integer, intent(in) :: nc
  real,    intent(in) :: off1
  real,    intent(in) :: off2
  real,    intent(in) :: aire
  real,    intent(in) :: sigma
  real,    intent(inout) :: tab(nl,nc)
  !
  if (n.gt.nl) return
  tab(n,1) = num
  tab(n,2) = off1
  tab(n,3) = off2
  tab(n,4) = aire
  tab(n,5) = sigma
end subroutine cido00
!
subroutine cido03 (num,off1,off2,nv,value,n,tab,nl,nc)
  !----------------------------------------------------------------------
  ! @ private
  ! CLASS Internal routine
  ! obsolete
  !----------------------------------------------------------------------
  integer num,n,nl,nc,nv,i
  real off1,off2,value(nv),tab(nl,nc)
  !
  if (n.gt.nl) return
  tab(n,1) = num
  tab(n,2) = off1
  tab(n,3) = off2
  do i=1,nv
     tab(n,3+i) = value(i)
  enddo
end subroutine cido03
!
subroutine cido04 (num,off1,off2,nv,val1,val2,val3,n,tab,nl,nc)
  !----------------------------------------------------------------------
  ! @ private
  ! CLASS Internal routine
  ! obsolete
  !----------------------------------------------------------------------
  integer num,n,nl,nc,nv,i
  real off1,off2,val1(nv),val2(nv),val3(nv),tab(nl,nc)
  if (n.gt.nl) return
  tab(n,1) = num
  tab(n,2) = off1
  tab(n,3) = off2
  do i=1,nv
     tab(n,3+i) = val1(i)
     tab(n,3+nv+i) = val2(i)
     tab(n,3+2*nv+i) = val3(i)
  enddo
end subroutine cido04
