subroutine write_fits_data (unit, iband, cmode, nsubant, subant,   &
    ldata, data , switch, error)
  use gildas_def
  use classic_api  
  !---------------------------------------------------------------------
  ! Write the CORRDATA  fits table.
  ! it has four columns.
  ! Assume one polarization, two sidebands.
  !---------------------------------------------------------------------
  integer :: unit                   !
  integer :: iband                  !
  character(len=*) :: cmode         !
  integer :: nsubant                !
  integer :: subant(nsubant)        ! selected antennas in table
  integer :: ldata                  !
  integer :: data(1)                !
  logical :: switch                 !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_number.inc'
  include 'gbl_pi.inc'
  include 'gbl_memory.inc'
  ! Local
  integer :: nch, itable
  integer :: k, mf, status, nrows, tfields, varidat, ir, h_offset
  integer :: naxis, naxes(4), nvector, krow, l_offset, ib, isb, ksb
  integer :: mdigit1, mdigit2, r_npol, r_nside, k1
  integer :: ntch, ich, k0, c_offset, nsb, kd, ia, ja, ncoldata, icol
  integer :: nsubbas, subbas(mnbas), isub, i, nswitch, jr, isw
  parameter(r_npol = 1, r_nside=2, mdigit2=13, mdigit1=8)
  real*8 :: fobs, ifval
  real :: ifinc, ifref, df, af
  parameter (mf = 5)
  character(len=16) :: ttype(mf),tform(mf),tunit(mf), extname
  character(len=1) :: ccol(2),c
  character(len=2) :: c2col(2),cc
  data ttype/     'INTEGNUM', 'STARTANT', 'ENDANT',  'DATA', 'DATA'/
  data tform/     '1J',       '1J',      '1J',       '1E',   '1E'/
  data tunit/     ' ',        ' ',       ' ',     ' ',     ' '/
  data ccol/'4','5'/, c2col/'4A','5B'/
  !---------------------------------------------------------------------
  ! nutator switch simulation (switch = .true.)
  if (switch) then
    nswitch = 2
  else
    nswitch = 1
  endif
  ! the baselines in subarray subant
  nsubbas = nsubant*(nsubant-1)/2
  do i = 1, nsubbas
    subbas(i) = basant(subant(antbas(1,i)), subant(antbas(2,i)))
  enddo
  !
  !  Append/create a new empty HDU onto the end of the file and move to it.
  status = 0
  call ftcrhd(unit,status)
  !
  !  Define parameters for the binary table (see the above data statements)
  !
  ! Continuum Temporal data
  if (cmode(1:2).eq.'CT') then
    !c         NROWS = R_NDUMP
    nrows = nswitch*r_ndump
    nch = 1
    ntch = r_nband
    ich = iband-1
    nsb = r_nsb
    ifref = 1d0
    ifval = r_cfcen(iband)*1e6
    ifinc = r_cfwid(iband)*1e6
    itable = 1
  ! Continuum Average data
  elseif (cmode(1:2).eq.'CA') then
    nrows = 1
    nch = 1
    ntch = r_nband
    ich = iband-1
    nsb = r_nsb
    ifref = 1d0
    ifval = r_cfcen(iband)*1e6
    ifinc = r_cfwid(iband)*1e6
    itable = 3
  ! Spectral Average data
  else
    nrows = 1                  ! r_nldump
    nch = r_lnch(iband)
    ntch = r_lntch
    ich = r_lich(iband)
    nsb = r_lnsb
    ifref = r_lcench(iband)
    ifval = r_lfcen(iband)*1e6
    ifinc = r_lfres(iband)*1e6
    itable = 2
  endif
  !      print *, 'cmode, nch ', cmode, nch
  tfields = mf
  if (r_lmode.eq.1) then
    extname = 'CORRDATA-ALMATI'
    naxes(1) = 2
    naxes(2) = nch
    naxes(3) = r_npol
    ! phase corrected / uncorrected
    if (r_ndatl.eq.2 .and. cmode(1:2).ne.'CT') then
      naxes(4) = r_ndatl
      naxis = 4
    ! only uncorrected
    else
      naxes(4) = 1
      naxis = 3
    endif
    ttype(2) = 'STARTANT'
    tform(2) = '1J'
    ttype(3) = 'ENDANT'
    tform(3) = '1J'
    ttype(4) = 'DATAUSB1'
    nvector = naxes(1) * naxes(2) * naxes(3) * naxes(4)
    ncoldata = 4
    call f_tform(tform(ncoldata),nvector,'E')
    ttype(5) = 'DATALSB1'
    nvector = naxes(1) * naxes(2) * naxes(3) * naxes(4)
    tfields = 5
    call f_tform(tform(ncoldata+1),nvector,'E')
    varidat = 0
    !
    call ftphbn(unit,nrows,tfields,ttype,tform,tunit,   &
      extname,varidat,status)
    call ftptdm(unit, ncoldata, naxis, naxes, status)
    call ftptdm(unit, ncoldata+1, naxis, naxes, status)
  else
    extname = 'AUTODATA-ALMATI'
    naxes(1) = nch
    naxes(2) = r_npol
    naxis = 2
    ttype(2) = 'ANTENNA'
    tform(2) = '1J'
    ttype(3) = 'DATA'
    nvector = naxes(1) * naxes(2)
    ncoldata = 3
    tfields = 3
    call f_tform(tform(ncoldata),nvector,'E')
    varidat = 0
    !
    call ftphbn(unit,nrows,tfields,ttype,tform,tunit,   &
      extname,varidat,status)
    call ftptdm(unit, ncoldata, naxis, naxes, status)
  endif
  ! Other header keywords
  call ftpkys(unit,'TABLEREV','v1.0 2001-07-03',   &
    extname//' release',status)
  if (status .gt. 0) goto 99
  call write_fits_dobs(unit,error)
  if (error) return
  call ftpkyj(unit,'NO_POL',r_npol,'Number of pols.',status)
  if (status .gt. 0) goto 99
  call ftpkyj(unit,'NO_SIDE',r_nside,'Number of side bands',status)
  if (status .gt. 0) goto 99
  call ftpkyj(unit,'NO_LO',2,'Number of LO''s',status)
  if (status .gt. 0) goto 99
  call ftpkyj(unit,'NO_PHCOR',r_ndatl,'Number of phase corr. data',   &
    status)
  call ftpkyj(unit,'CHANNELS',nch,   &
    'number of channels in baseband',status)
  call ftpkyj(unit,'BASEBAND',iband,'Baseband number',status)
  call ftpkyj(unit,'TABLEID',itable,'Baseband table number ',status)
  !
  call ftpkys(unit,'TRANSITA',r_lnam(1,iband),   &
    'Line Transition A',status)
  call ftpkyd(unit,'RESTFREA',r_lrfoff(1,iband)*1d6,mdigit2,   &
    'Rest  Freq. A (Hz) at reference channel',status)
  call ftpkys(unit,'TRANSITB',r_lnam(2,iband),   &
    'Line Transition B',status)
  call ftpkyd(unit,'RESTFREB',r_lrfoff(2,iband)*1d6,mdigit2,   &
    'Rest  Freq. B (Hz) at reference channel',status)
  !      FIMAGE = R_LRFOFF(ISB,IBAND)
  !     $+(2*ISB-3)*2/(1+R_DOPPL)
  !     $*(R_FLO2-R_LFCEN(IBAND)
  !     $-(R_LRCH(ISB,IBAND)-R_LCENCH(IBAND))*R_LFRES(IBAND))
  !      CALL FTPKYD(UNIT,'IMAGFREQ',FIMAGE*1D6,MDIGIT2,
  !     $'Image Freq. (Hz) at reference channel',STATUS)
  !      call ftpkyd(unit,'IF_REF',ifref,mdigit2,
  !     &     'Reference channel',status)
  call ftpkyd(unit,'INTERFRE',ifval,mdigit2,   &
    'Intermediate Freq. (Hz) at reference channel',status)
  !      call ftpkyd(unit,'IFINC',ifinc,mdigit2,
  !     &     'IF Value at Reference channel',status)
  call ftpkyd(unit,'FREQLO1',r_flo1*1d6,mdigit2,   &
    'Local Oscillator 1',status)
  call ftpkyj(unit,'SIDEBLO1',r_isb,   &
    'Side Band LO 1',status)
  call ftpkyd(unit,'FREQLO2',r_flo1_ref*1d6,mdigit2,   &
    'Local Oscillator 2',status)
  call ftpkyj(unit,'SIDEBLO2',-1,   &
    'Side Band LO 2',status)
  if (r_flux.ne.0) then
    call ftpkye(unit,'IFLUX',r_flux,mdigit1,'Flux in I (Jy)',   &
      status)
  endif
  if (r_lmode.eq.1) then
    ! Column 4, First data axis
    do isb=1, 2
      c = ccol(isb)
      cc = c2col(isb)
      call ftpkys(unit,'1CTYP'//c,'COMPLEX','Complex axis',status)
      call ftpkye(unit,'1CRPX'//c,1.0,mdigit1,' ',status)
      call ftpkye(unit,'1CRVL'//c,1.0,mdigit1,' ',status)
      call ftpkye(unit,'11CD'//c,1.0,mdigit1,' ',status)
      ! Second data axis: frequency.
      call ftpkys(unit,'2CTYP'//c,'FREQ-FRQ',   &
        'Observed Frequency axis',status)
      call ftpkye(unit,'2CRPX'//c,ifref,mdigit1,   &
        'reference pixel',status)
      ksb = 3-2*isb
      fobs = (r_flo1+ksb*(r_flo1_ref-r_lfcen(iband)))*1d6
      df = -ifinc*ksb
      call ftpkyd(unit,'2CRVL'//c,fobs,mdigit2,   &
        'Observed Freq.(Hz) at ref. pixel in Hz ',status)
      call ftpkye(unit,'22CD'//c,df,mdigit1,   &
        'Channel separation in Hz ',status)
      ! Second data axis: velocity.
      if (nch.gt.1) then
        call ftpkys(unit,'2CTYP'//cc,'VRAD-FRQ',   &
          'Velocity axis',status)
        call ftpkye(unit,'2CRPX'//cc,r_lrch(isb,iband),mdigit1,   &
          'reference pixel',status)
        call ftpkyd(unit,'2CRVL'//cc,r_lvoff(isb,iband)*1d3,   &
          mdigit2,'Velocity (m/s)  at reference channel',   &
          status)
        call ftpkye(unit,'22CD'//cc,r_lvres(isb,iband)*1e3,   &
          mdigit2,'Channel spacing in velocity (m/s)',status)
        call ftpkys(unit,'2CUNI'//cc,'m/s',   &
          'Velocity unit axis',status)
        call ftpkyd(unit,'2VSOU'//cc,r_lvoff(isb,iband)*1d3,   &
          mdigit2,'Source Velocity (m/s)',status)
        call ftpkys(unit,'2SPEC'//cc,'LSRK-TOP',   &
          'Velocity System',status)
      endif
      ! Third data axis: Stokes parameters
      call ftpkys(unit,'3CTYP'//c,'STOKES','Stokes axis',status)
      call ftpkye(unit,'3CRPX'//c,1.0,mdigit1,' ',status)
      call ftpkye(unit,'3CRVL'//c,-5.0,mdigit1,' ',status)
      call ftpkye(unit,'33CD'//c,-1.0,mdigit1,' ',status)
      ! Fourth data axis: Phase correction
      if (naxis.gt.3) then
        c = ccol(isb)
        cc = c2col(isb)
        call ftpkys(unit,'4CTYP'//c,'PHASCORR',   &
          'Phase Correction',status)
        call ftpkye(unit,'4CRPX'//c,1.0,mdigit1,' ',status)
        call ftpkye(unit,'4CRVL'//c,0.0,mdigit1,' ',status)
        call ftpkye(unit,'44CD'//c,1.0,mdigit1,' ',status)
      endif
    enddo
  else
    ! Autocorrelation ...
    ! First data axis: frequency.
    call ftpkys(unit,'1CTYP3','FREQ-FRQ',   &
      'Observed Frequency axis',status)
    call ftpkye(unit,'1CRPX3',ifref,mdigit1,   &
      'reference pixel',status)
    ksb = r_isb
    fobs = (r_flo1+ksb*(r_flo1_ref-r_lfcen(iband)))*1d6
    df = -ifinc*ksb
    call ftpkyd(unit,'1CRVL3',fobs,mdigit2,   &
      'Observed Freq.(Hz) at ref. pixel in Hz ',status)
    call ftpkye(unit,'11CD3',df,mdigit1,   &
      'Channel separation in Hz ',status)
    !  First data axis: velocity
    if (nch.gt.1) then
      isb = (3-r_isb)/2
      call ftpkys(unit,'1CTYP3A','VRAD-FRQ',   &
        'Velocity axis',status)
      call ftpkye(unit,'1CRPX3A',r_lrch(isb,iband),mdigit1,   &
        'reference pixel',status)
      call ftpkyd(unit,'1CRVL3A',r_lvoff(isb,iband)*1d3,mdigit2,   &
        'Velocity (m/s)  at reference channel',status)
      call ftpkye(unit,'11CD3A',r_lvres(isb,iband)*1e3,mdigit2,   &
        'Channel spacing in velocity (m/s)',status)
      call ftpkys(unit,'1CUNI3A','m/s',   &
        'Velocity unit axis',status)
      call ftpkyd(unit,'1VSOU3A',r_lvoff(isb,iband)*1d3,mdigit2,   &
        'Source Velocity (m/s)',status)
      call ftpkys(unit,'1SPEC3A','LSRK-TOP','Velocity System',   &
        status)
    endif
    ! Third data axis: Stokes parameters
    call ftpkys(unit,'2CTYP3','STOKES','Stokes axis',status)
    call ftpkye(unit,'2CRPX3',1.0,mdigit1,' ',status)
    call ftpkye(unit,'2CRVL3',-5.0,mdigit1,' ',status)
    call ftpkye(unit,'22CD3',-1.0,mdigit1,' ',status)
  endif
  if (status .gt. 0) goto 99
  ! loop on table rows
  krow = 0
  do ir=1, nrows
    ! when simulating switching, use the same data for ON and OFF starts
    ! of one cycle.
    if (switch) then
      jr = (ir+1)/2
      isw = ir+2-2*jr
    else
      jr = ir
      isw = 0
    endif
    k = 1+ h_offset(jr)
    !c         K = 1 + H_OFFSET(IR)
    call decode_header (data(k))
    ! Continuum Temporal data
    if (cmode(1:2).eq.'CT') then
      k0 = 1 + c_offset(jr)
    ! The average data does not reflect simulated switching (for now)
    ! Continuum Average data (opt. including corrected data)
    elseif (cmode(1:2).eq.'CA') then
      k0 = 1 + c_offset(r_ndump+1)
      if (r_ndatl.eq.2) then
        k1 = 1 + c_offset(r_ndump+2)
      endif
    ! Spectral Average data (opt. including corrected data)
    else
      k0 = 1 + l_offset(r_ndump+1)
      if (r_ndatl.eq.2) then
        k1 = 1 + l_offset(r_ndump+2)
      endif
    endif
    if (r_lmode.eq.1) then
      ! Correlation: Loop on baselines
      do isub=1, nsubbas
        ib = subbas(isub)
        !
        krow = krow+1
        !
        ! Fill in the columns:
        ! INTEGNUM
        call ftpclj(unit,1,krow,1,1,dh_dump,status)
        ia = r_iant(ib)
        ja = r_jant(ib)
        ! STARTANT
        call ftpclj(unit,2,krow,1,1,antbas(1,isub),status)
        ! ENDANTEN
        call ftpclj(unit,3,krow,1,1,antbas(2,isub),status)
        ! DATA
        ! Loop on  sidebands
        icol = ncoldata
        do isb = 1, r_nside
          if (r_lcal) then
            af = sqrt(dh_atfac(1,isb,ia)*dh_atfac(1,isb,ja))
          else
            af = 1.0
          endif
          ! phase uncorrected
          kd = k0   &
            + (ich+(isb-1+(ib-1)*nsb)*ntch)*2
          call rescale(2*nch,data(kd),af)
          call ftpcle(unit,icol,krow,1,2*nch,   &
            data(kd),status)
          ! phase corrected, for averaged data only.
          if (r_ndatl.eq.2 .and. cmode(1:2).ne.'CT') then
            kd = k1   &
              + (ich+(isb-1+(ib-1)*nsb)*ntch)*2
            call rescale(2*nch,data(kd),af)
            call ftpcle(unit,icol,krow,1+2*nch,2*nch,   &
              data(kd),status)
          endif
          icol = icol+1
        enddo
      enddo
    else
      ! AutoCorrelation Loop on antennas
      do isub=1, nsubant
        ia = subant(isub)
        krow = krow+1
        !
        ! Fill in the columns:
        ! INTEGNUM
        call ftpclj(unit,1,krow,1,1,dh_dump,status)
        ! ANTENNA
        call ftpclj(unit,2,krow,1,1,isub,status)
        ! DATA
        if (r_lcal) then
          af = dh_atfac(1,1,ia)
        else
          af = 1.0
        endif
        kd = k0 + ich+(ia-1)*ntch
        call rescale(nch,data(kd),af)
        call ftpcle(unit,ncoldata,krow,1,nch,   &
          data(kd),status)
      enddo
    endif
  enddo
  if (status .gt. 0) goto 99
  return
  ! Error return
99 call printerror('WRITE_FITS_DATA',status)
  error = .true.
end subroutine write_fits_data
