!
subroutine gio_uvwps(awps)
  use gio_fitsdef
  ! @ public
  !
  real, intent(out) :: awps
  !
  awps = wps
end subroutine gio_uvwps
!
subroutine touvt(fits,istyle,what,check,error,pcount,getsymbol)
  use gbl_message
  use phys_const
  use image_def
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>touvt
  use gio_fitsdef
  !---------------------------------------------------------------------
  ! @ private
  ! Read a UVFITS file from tape and convert it to GDF format in virtual
  ! memory.
  !---------------------------------------------------------------------
  type(gildas),    intent(inout) :: fits       !
  integer(kind=4), intent(in)    :: istyle     ! A cryptic style code, 1,2 or something else
  logical,         intent(in)    :: what       ! Prompt on unknown axis types ?
  logical,         intent(in)    :: check      ! Verbose flag
  logical,         intent(out)   :: error      ! Error flag
  integer(kind=4), intent(out)   :: pcount     ! Parameter count
  external                       :: getsymbol  ! FITS Keyword translation routine
  ! 
  ! Global
  character(len=*), parameter :: rname = 'TOUVT'
  character(len=1), parameter :: quote = ''''
  !
  ! Local
  real(kind=4) :: rmin,rmax
  integer(kind=4) :: id,iy,im,idate
  !
  real(kind=4) :: xs
  real(kind=8) :: x
  integer(kind=4) :: nr(mcount)
  integer(kind=4) :: naxis, nif
  integer(kind=4) :: i,j,narg,ind,i1,i2,k
  integer(kind=4) :: ier,ialtrpix,iaxis, iv, obs_vtyp
  real(kind=8) :: my_convert(3), altrpix, altrval, f, vv, v, dummy(3), my_voff, afreq
  logical :: have_altrval, have_velref, have_velo, have_vres, have_zsou, have_epoch, have_point
  logical :: from_casa, warn
  character(len=8) :: trans,comm
  character(len=70) :: argu
  character(len=message_length) :: mess
  character(len=80) :: chain
  integer, allocatable :: tmp_stokes(:)
  integer :: old_stokes
  !
  ! Reset
  call gio_message(seve%t,rname,'Entering...')
  !
  error = .false.
  have_altrval = .false.
  have_velref = .false.
  have_velo = .false.
  have_zsou = .false.
  have_vres = .false.
  have_epoch = .false.
  have_point = .false.
  from_casa = .false.
  obs_vtyp = vel_unk
  !
  f = 0.d0
  !
  wps = 1.0
  ialtrpix = 0
  call gildas_null(fits, type = 'UVT')
  call sic_parsef(gdfname,fits%file,' ','.uvt')
  fits%gil%version_uv = code_version_uvt_dopp   ! Will use Doppler information
  fits%gil%voff = 0.0
  fits%gil%dopp = 0.0
  !
  fd%bscal = 1.0
  fd%bzero = 0.0
  ! Use pixel units as default if increments are not defined
  call gfits_flush_data(error)
  if (error) return
  ! First line SIMPLE
  call gfits_get(comm,argu,check,error)
  if (error) return
  if (comm.ne.'SIMPLE') then
    call gio_message(seve%e,'FITS','Not a FITS file at all')
    goto 99
  endif
  narg = len(argu)
  call sic_blanc(argu,narg)
  if (argu.ne.' T' .and. argu.ne.'T') then
    call gio_message(seve%w,'FITS','Not a SIMPLE FITS file')
    goto 99
  endif
  !
  ! Second line BITPIX
  call gfits_get(comm,argu,check,error)
  if (error) return
  if (comm.ne.'BITPIX') then
    call gio_message(seve%e,'FITS','Not a standard FITS file, no BITPIX')
    goto 99
  endif
  read(argu,*,iostat=ier) x
  fd%nbit=nint(x)
  if (fd%nbit.ne.16 .and. fd%nbit.ne.32 .and.fd%nbit.ne.-32) then
    write(mess,101) 'Cannot handle ',fd%nbit,' bits'
    call gio_message(seve%e,'UVFITS',mess)
    goto 99
  endif
  !
  ! Third line NAXIS
  call gfits_get(comm,argu,check,error)
  if (error) return
  read(argu,*,iostat=ier) x
  naxis=int(x)
  if (naxis.ne.6 .and. naxis.ne.7) then
    call gio_message(seve%e,'UVFITS','No UV data in file')
    goto 99
  endif
  !
  ! Next NAXIS lines axis dimensions
  do i=1,naxis
    call gfits_get(comm,argu,check,error)
    if (error) return
    read(argu,*,iostat=ier) x
    nr(i)=nint(x)
    if (i.eq.1 .and. nr(i).ne.0) then
      call gio_message(seve%e,'UVFITS','Not a standard UVFITS file')
      goto 99
    elseif (i.gt.mcount .and. nr(i).ne.1) then
      call gio_message(seve%e,'UVFITS','Too many dimensions')
      goto 99
    endif
    if (ier.ne.0) call gio_message(seve%e,'UVFITS','Error reading '//comm//argu)
  enddo
  !
  fits%gil%ptyp = p_azimuthal    ! Azimuthal projection
  ier = 0
  !
  ! Now find the real information.
  !
20 if (ier.ne.0) call gio_message(seve%e,'UVFITS','Error reading '//comm//argu)
  ier = 0
  error = .false.
  call gfits_get(comm,argu,check,error)
  if (error) return
  call getsymbol (comm,trans,error)
  if (error) then
    error = .false.
  else
    comm = trans
  endif
  !
  select case (comm)
  case ('BSCALE')
    read(argu,*,iostat=ier) cscal
  case ('BZERO')
    read(argu,*,iostat=ier) czero
  case ('DATAMIN')
    read(argu,*,iostat=ier) rmin
  case ('DATAMAX')
    read(argu,*,iostat=ier) rmax
  case ('BUNIT')
    read(argu,1001,iostat=ier) chain
    fits%char%unit = chain(2:)
    ind = index(fits%char%unit,quote)
    if (ind.gt.0) fits%char%unit(ind:) = ' '
  case ('GROUP')
    continue
  case ('PCOUNT')
    read(argu,*,iostat=ier) x
    pcount = nint(x)
  case ('GCOUNT')
    read(argu,*,iostat=ier) x
    fits%gil%nvisi = nint(x)
  case ('EPOCH')
    read(argu,*,iostat=ier) fits%gil%epoc
    have_epoch = .true.
  case ('EQUINOX')
    read(argu,*,iostat=ier) fits%gil%epoc
  case ('OBSRA')
    read(argu,*,iostat=ier) x
    fits%gil%ra = x*pi/180.0d0
    have_point = .true.
    fits%char%syst = 'EQUATORIAL'
  case ('OBSDEC')
    read(argu,*,iostat=ier) x
    fits%gil%dec = x*pi/180.0d0
    have_point = .true.
    fits%char%syst = 'EQUATORIAL'
    !
  case ('OBJECT')
    read(argu,1001,iostat=ier) chain
    fits%char%name = chain(2:)
    ind = index(fits%char%name,quote)
    if (ind.gt.0) fits%char%name(ind:) = ' '
  case ('LINE')
    read(argu,1001,iostat=ier) chain
    fits%char%line = chain(2:)
    ind = index(fits%char%line,quote)
    if (ind.gt.0) fits%char%line(ind:) = ' '
!
! Standard Frequency / Velocity axis
  case ('RESTFREQ')
    read(argu,*,iostat=ier)  f
    fits%gil%spec_words = 12
  case ('SPECSYS')
    i1 = index(argu,quote)+1
    i2 = index(argu(i1:),quote)-2+i1
    chain = argu(i1:i2)
    if (chain.eq.'LSRK') then
      fits%gil%vtyp = vel_lsr
    else if (chain.eq.'HEL') then
      fits%gil%vtyp = vel_hel
    else if (chain.eq.'TOPOCENT') then
      fits%gil%vtyp = vel_obs
    endif
  case ('SSYSSRC')
    i1 = index(argu,quote)+1
    i2 = index(argu(i1:),quote)-2+i1
    chain = argu(i1:i2)
    if (chain.eq.'LSRK') then
      fits%gil%vtyp = vel_lsr
    else if (chain.eq.'HEL') then
      fits%gil%vtyp = vel_hel
    else if (chain.eq.'TOPOCENT') then
      fits%gil%vtyp = vel_obs
    endif
  case ('ZSOURCE')
    read(argu,*,iostat=ier)  x
    have_zsou = .true.
    fits%gil%voff = x/1d3
    fits%gil%spec_words = 12
  case ('VELOSYS')
    read(argu,*,iostat=ier)  x
    fits%gil%dopp = x/299792.458d3
    fits%gil%spec_words = 12
  case ('SSYSOBS')
    i1 = index(argu,quote)+1
    i2 = index(argu(i1:),quote)-2+i1
    chain = argu(i1:i2)
    if (chain.eq.'LSRK') then
      obs_vtyp = vel_lsr
    else if (chain.eq.'BARYCENT') then
      obs_vtyp = vel_hel
    else if (chain.eq.'TOPOCENT') then
      obs_vtyp = vel_obs
    else if (chain.eq.'GEOCENT') then
      obs_vtyp = vel_ear
    endif
!
! Old Frequency / Velocity axis
  case ('VELO-LSR','VLSR')
    read(argu,*,iostat=ier)  v
    have_velo = .true.
    fits%gil%spec_words = 12
  case ('VELREF')
    read(argu,*,iostat=ier)  vv
    have_velref = .true.
    fits%gil%spec_words = 12
  case ('ALTRVAL')
    read(argu,*,iostat=ier)  altrval
    have_altrval = .true.
    fits%gil%spec_words = 12
  case ('ALTRPIX')
    ! ALTRPIX indicate Reference pixel for Frequency / Velocity axis
    read(argu,*,iostat=ier)  altrpix
    fits%gil%spec_words = 12
  case ('DELTAV')
    read(argu,*,iostat=ier) x
    fits%gil%vres = x*1d-3
    have_vres = .true.
  case ('IMAGFREQ')
    read(argu,*,iostat=ier) x
    fits%gil%fima = x*1d-6
  !
  case ('DATE-OBS')
    i1 = index(argu,quote)+1
    i2 = index(argu(i1:),quote)-2+i1
    ! make provision for old DATE-OBS format:
    ind = index(argu(i1:i2),'/')
    if(ind.eq.0) then          ! new ISO date format
      read(argu(i1:i2),1004,iostat=ier) iy,im,id
    else
      read(argu(i1:i2),1003,iostat=ier) id,im,iy
      iy = 1900+iy
    endif
    call gag_datj(id,im,iy,idate)
    !
    ! Try to grasp the WTSCAL hidden keyword
  case ('HISTORY')
    ind = index(argu,'WTSCAL')
    if (ind.ne.0) then
      read(argu(ind+9:),*,iostat=ier) wps
    endif
    !
  case ('END')
    goto 30
    !
  case ('ORIGIN')
     call gio_message(seve%i,'FITS','Origin is ['//trim(argu)//']')
     if (argu.eq."'casacore '") from_casa = .true.
  case('TELESCOP')
    i1 = index(argu,quote)+1
    i2 = index(argu(i1:),quote)-2+i1
    call gdf_addteles(fits,'TELE',argu(i1:i2),dummy,error)
  case default
    ! Identify the named axes
    select case (comm(1:5))
    case ('CTYPE')
      read(comm(6:6),'(I1)',iostat=ier) iaxis
      read(argu,*,iostat=ier) chain
      ctype(iaxis) = chain
    case ('CRVAL')
      read(comm(6:6),'(I1)',iostat=ier) iaxis
      read(argu,*,iostat=ier) x
      crval(iaxis) = x
    case ('CRPIX')
      read(comm(6:6),'(I1)',iostat=ier) iaxis
      read(argu,*,iostat=ier) x
      crpix(iaxis) = x
    case ('CDELT')
      read(comm(6:6),'(I1)',iostat=ier) iaxis
      read(argu,*,iostat=ier) x
      cdelt(iaxis) = x
      ! and the groups
    case ('PTYPE')
      read(comm(6:6),'(I1)',iostat=ier) iaxis
      read(argu,*,iostat=ier) chain
      ptype(iaxis) = chain
    case ('PSCAL')
      read(comm(6:6),'(I1)',iostat=ier) iaxis
      read(argu,*,iostat=ier) x
      pscal(iaxis) = x
    case ('PZERO')
      read(comm(6:6),'(I1)',iostat=ier) iaxis
      read(argu,*,iostat=ier) x
      pzero(iaxis) = x
    end select
      !
  end select
  !! Print *,'Comm '//comm,fits%char%syst
  goto 20
  !
  ! Finish Header
30 continue
  !
  ! Consistency check for reference frames
  if (obs_vtyp.eq.fits%gil%vtyp) then
    if (fits%gil%dopp.ne.0) then
      call gio_message(seve%w,rname,'SPECSYS = SSYSOBS,  Doppler reset to zero')
      fits%gil%dopp =0
    endif
  else
    if (fits%gil%dopp.eq.0) call gio_message(seve%w,rname, &
      &  'Warning, no Doppler factor found, spatial resolution inaccurate')
  endif
  !
  ! Set the Rest Frequency if RESTFREQ has been given
  fits%gil%freq = f*1d-6
  !
  if (fits%gil%spec_words.ne.0) then
    !
    ! Use ALTRVAL if defined...
    if (have_altrval) then
      have_velo = .true.
      v = altrval
    endif
    !
    if (have_velo) then
      fits%gil%voff = v*1d-3
      if (have_velref) then
        if (fits%gil%vtyp.ne.vel_unk) then
          call gio_message(seve%w,rname,'Velocity type already set by SPECSYS -- VELREF keyword ignored')
        else
          iv = nint(vv)
          if (vv-iv.eq.0.0) then
            if (iv.gt.256) then
              iv = iv-256
            endif
            if (iv.gt.0 .and. iv.lt.4) then
              fits%gil%vtyp = iv
            endif
          endif
          if (fits%gil%vtyp.eq.vel_unk) then
            call gio_message(seve%w,rname,'Invalid VELREF, Referential set to Unknown')
          endif
        endif
      endif
    else
      if (have_velref) then
        call gio_message(seve%w,rname,'Obsolete use of VELREF as Velocity value (cm/s)')
        fits%gil%voff = vv*1d-5  ! Obsolete use of VELREF
        have_velo = .true.
      endif
    endif
  endif
  !
  ! Re-order the axes informations
  fits%gil%ndim = 2
  fits%gil%nchan = 1
  fits%gil%nstokes = 1
  nif = 1
  !
  fits%gil%order = 0
  !
  do i=2,naxis
    select case (ctype(i))
    case ('FREQ')
      my_convert(2) = crval(i)*1d-6
      !
      ! This is a problem:  We use  TWO frequencies for GILDAS, one
      ! for the spectral line, the other for the effective wavelength
      !
      ! FITS only uses one, in the SPECSYS system.
      !
      if (fits%gil%freq.eq.0) fits%gil%freq = my_convert(2)
      my_convert(3) = cdelt(i)*1d-6
      if (ialtrpix.eq.0) my_convert(1) = crpix(i) ! check for ALTRPIX
      fits%gil%nchan = fits%gil%nchan*nr(i)
      if (fits%gil%order.eq.0) fits%gil%order = code_chan_stok ! Stokes/Channel order
    case ('STOKES')
      write(mess,*) 'Found ',nr(i),' STOKES'
      call gio_message(seve%i,'UVFITS',mess)
      fits%gil%nstokes = fits%gil%nstokes*nr(i)
      if (fits%gil%order.eq.0) fits%gil%order = code_stok_chan ! Stokes/Channel order
      allocate (fits%gil%stokes(fits%gil%nstokes), stat=ier)
      !
      ! and recode it into the Gildas convention.
      do j=1,nr(i)
        xs = (j-crpix(i))*cdelt(i)+crval(i)
        fits%gil%stokes(j) = stokes_from_fits(xs)
      enddo
      if (fits%gil%nstokes.eq.1) then
        fits%gil%order = 0 ! By default, no Stokes, no Order
      endif
    case ('IF')
      if (nr(i).ne.1) then
        write(mess,*) 'Found ',nr(i),' IFs'
        call gio_message(seve%i,'UVFITS',mess)
        nif = nif*nr(i)
      endif
    case ('RA')
      fits%gil%a0 = pi*crval(i)/180.d0
      have_epoch = .true.
    case ('DEC')
      fits%gil%d0 = pi*crval(i)/180.d0
      have_epoch = .true.
    case ('COMPLEX')
      continue
    case default
      write(mess,*) 'Unrecognized CTYPE '//ctype(i),i
      call gio_message(seve%w,'UVFITS',mess)
    end select
  enddo
  if (fits%gil%nstokes.ne.1) then
    continue
  else if (abs(fits%gil%order).eq.abs(code_chan_stok)) then
    fits%gil%order = 0  ! By default, no Stokes so no Order
  endif
  if (nif.gt.1) then
    call gio_message(seve%w,'UVFITS','More than 1 IF value, trying...')
    fits%gil%nchan = fits%gil%nchan * nif
    !
    ! Here we should allocate a Random Frequency axis
    fits%gil%nfreq = fits%gil%nchan * fits%gil%nstokes
    allocate(fits%gil%freqs(fits%gil%nfreq),stat=ier)
  endif
  fits%gil%dim(1) = 7+3*fits%gil%nchan*fits%gil%nstokes
  !
  ! For the groups, it is more complex
  call key_order(pcount,fits%char%syst)
  !
  ! Add trailing columns if needed -
  if (lsour.ne.0) then
    !
    ! Formally, the additional column contains the Source IDs
    !
    ! It will need to be transformed into phase center columns
    ! for further processing by GILDAS, by task uv_update_fields
    fits%gil%ntrail = fits%gil%ntrail+2
    fits%gil%dim(1) = fits%gil%dim(1)+fits%gil%ntrail
    ! Strictly speaking this is the code to use
    fits%gil%column_pointer(code_uvt_id) = fits%gil%dim(1)-1
    fits%gil%column_size(code_uvt_id) = 1
    ! but it requires some protection in MAPPING and IMAGER
    ! to avoid imaging these as Single Fields
    ! and a place-holder to reserve space for in-place conversion to 
    ! phase offsets
    fits%gil%column_pointer(code_uvt_moff) = fits%gil%dim(1)
    fits%gil%column_size(code_uvt_moff) = 1
    fits%char%syst = 'EQUATORIAL'
    !
    !! Older versions used this fudge instead:
    !!fits%gil%column_pointer(code_uvt_loff) = fits%gil%dim(1)+1
    !!fits%gil%column_pointer(code_uvt_moff) = fits%gil%dim(1)+2
    !!fits%gil%column_size(code_uvt_loff) = 1
    !!fits%gil%column_size(code_uvt_moff) = 1
!
! This could be present if RAOBS and DECOBS are actually present
!    in the AIPS_SU Table.  However, it seems CASA does not do
!    that for the time being...
!
!    fits%gil%column_pointer(code_uvt_xoff) = fits%gil%dim(1)+1
!    fits%gil%column_pointer(code_uvt_yoff) = fits%gil%dim(1)+2
!    fits%gil%column_size(code_uvt_xoff) = 1
!    fits%gil%column_size(code_uvt_yoff) = 1
!
  else if (have_epoch) then
    fits%char%syst = 'EQUATORIAL'
    !
    if (.not.have_point) then
      ! Set up the pointing coordinates by default if not already done
      fits%gil%ra = fits%gil%a0
      fits%gil%dec = fits%gil%d0
    endif
  endif
  !
  fits%gil%dim(2) = fits%gil%nvisi
  fits%gil%faxi = 1 ! Frequency axis is 1
  !
  fits%gil%convert(:,1) = my_convert
  fits%gil%fres = my_convert(3) ! This is the frequency resolution
  !
  if (nif.gt.1) then 
    if (fits%gil%nstokes.eq.1) then
      ! No Stokes defined. OK, but we actually need one for Simplicity...
      if (associated(fits%gil%stokes)) then
        old_stokes = fits%gil%stokes(1)
        deallocate(fits%gil%stokes)      
      else
        old_stokes = 0
      endif
      allocate(fits%gil%stokes(fits%gil%nfreq))
      do i=1,fits%gil%nfreq
        afreq = (i-my_convert(1))*my_convert(3)+my_convert(2)
        fits%gil%freqs(i) = afreq
      enddo
      fits%gil%stokes = old_stokes ! Should be the proper code...
      ! 
      ! Small patch to avoid purely linear axis
      fits%gil%freqs(fits%gil%nfreq) = fits%gil%freqs(1)  !!Under TEST
    else
      ! The STOKES parameters must now be defined for each channel
      write(mess,'(I0,A,I0,A,I0,A,I0,A)') fits%gil%nstokes,' Stokes, ' &
        & ,nif,' IFs, ',fits%gil%nchan,' Channels, and ',fits%gil%nfreq,' Freqs.' !!Under TEST
      call gio_message(seve%w,rname,mess)
      !
      allocate(tmp_stokes(fits%gil%nstokes))
      tmp_stokes(:) = fits%gil%stokes(:)
      deallocate (fits%gil%stokes)
      allocate(fits%gil%stokes(fits%gil%nfreq),stat=ier)
      if (ier.ne.0) then
        call gio_message(seve%e,rname,'Memory allocation error')
        error = .true.
        return
      endif
      !
      ! Fill the random frequency axis with the standard formula
      !   A script will add later the proper information
      ! The filling depends on which order (Stokes vs Channel or Channel vs Stokes)
      !
      !DEBUG! Print *,'ORDER ',fits%gil%order,code_stok_chan,code_chan_stok
      if (fits%gil%order.eq.code_stok_chan) then
        !
        ! code here is for Stokes being faster, channels slower, IF latest
        !
        k = 0
        do i=1,fits%gil%nchan
          afreq = (i-my_convert(1))*my_convert(3)+my_convert(2)
          do j=1,fits%gil%nstokes
            k = k+1
            fits%gil%stokes(k) = tmp_stokes(j)
            fits%gil%freqs(k) = afreq
          enddo
        enddo
        !DO NOT RESET THIS...!  fits%gil%order = 0 ! No order, specified by the Stokes array...
      else if (fits%gil%order.eq.code_chan_stok) then
        k = 0
        do j=1,fits%gil%nstokes
          do i=1,fits%gil%nchan
            k = k+1
            afreq = (i-my_convert(1))*my_convert(3)+my_convert(2)
            fits%gil%stokes(k) = tmp_stokes(j)
            fits%gil%freqs(k) = afreq
          enddo
        enddo
      else
        call gio_message(seve%e,rname,'Invalid Stokes / Channel order ')
        Print *,'Order ',fits%gil%order,' codes ',code_stok_chan,code_chan_stok
      endif
    endif
  endif
  !
  ! Set the source velocity unless it has already been set
  my_voff = -clight_kms*(my_convert(2)-fits%gil%freq)/fits%gil%freq
  if (fits%gil%voff.eq.0.d0) then
    fits%gil%voff = my_voff
    write(mess,'(A,1PG12.5,A,0PF15.6)') 'Offset velocity set to ', &
      & fits%gil%voff,' and Rest Frequency to ',fits%gil%freq
    call gio_message(seve%w,'FITS',mess)
    fits%gil%vres = -clight_kms*fits%gil%fres/fits%gil%freq
    !
    ! Unless we are in CODE_VERSION_UVT_FREQ version (2.0), the
    ! frequency axis must be in the Source frame, whatever its velocity
    !
    if (fits%gil%version_uv.ne.code_version_uvt_freq) then
      fits%gil%convert(2,1) = fits%gil%freq
      if (my_voff.ne.0.d0) call gio_message(seve%w,'FITS','Frequency axis reset to Source frame')
    endif
  else
    if (fits%gil%voff.ne.my_voff) then
      if (have_zsou) then
        ! Used ZSOURC keyword to specify the Source frame.
        ! Every thing should be OK if My_Voff is 0
        warn = my_voff.ne.0.
      else
        warn = .true.
      endif
      if (warn) then
        write(mess,'(A,1PG12.5,A)') 'Inconsistent velocity offset ', &
        & my_voff,' from ZSOURCE, VELO-LSR or VLSR keywords '
        call gio_message(seve%w,'FITS',mess)
        write(mess,'(A,1PG12.5,A)') '   and ',fits%gil%voff, &
        & ' from Frequency axis'
        call gio_message(seve%w,'FITS',mess)
      endif
    endif
    x = -clight_kms*fits%gil%fres/fits%gil%freq
    if (have_vres) then
      if (abs(fits%gil%vres-x).gt.0.001*abs(x)) then
        call gio_message(seve%w,'FITS','Velocity resolution appears inconsistent')
      endif
    else
      fits%gil%vres = x
    endif
  endif
  !
  ! Assume Jy if no Unit specified
  if (fits%char%unit.eq.'UNCALIB') fits%char%unit='Jy'
  !
  ! Finally set the Weight correctly
  !   There is no clearly described convention in UVFITS. 
  !
  ! -) GILDAS uses a per-channel bandwidth, as internally.
  !
  ! -) From experience, weights given by CASA should be multiplied
  ! by the number of channels. It makes no sense, since if the 
  ! CASA weight were those of the aggregate bandwidth, one should
  ! instead **divide** by the number of channels, not **multiply**.
  ! So one may expect some change from CASA at some point... 
  !   Note that the number of Stokes states does not matter here,
  ! as each Stokes has its own weight.
  !
  ! -) WTSCAL should be used if present (e.g. VLA data), either directly
  ! or in the HISTORY keywords.
  !
  if (from_casa) then
    if (wps.eq.1.0) then
      wps = fits%gil%nchan 
    endif
  endif
  !
  ! the WTSCAL keyword can be overridden by the user with a SIC Symbol
  comm = 'WTSCAL'
  call getsymbol(comm,trans,error)
  if (error) then
    error = .false.
  else
    if (from_casa) call gio_message(seve%w,'FITS','CASA weight overridden by user')
    read(trans,*,iostat=ier) wps
    write(mess,*) 'Found user specified WPS ',wps
    call gio_message(seve%i,rname,mess)
  endif
  !
  ! Check header consistency
  call gio_setuv(fits%gil,error)
  !
  call gio_message(seve%t,rname,'Leaving...')
  return
  !
99 error = .true.
  call gio_message(seve%e,'FITS','Command was: '//comm//' '//argu)
  !
101 format(1x,a,i6,a)
1001 format(a)
1003 format(i2,1x,i2,1x,i2)
1004 format(i4,1x,i2,1x,i2)

!-----------------------------------------------------------------------
!              --- Velocities in UVFITS ---
!
! By convention in the WCS coordinate system handling, only
! Frequencies in the specified referential (e.g. LSRK) are given.
! A Rest Frequency is mentionned "for information only", and it
! is up to the user to perform the Frequency --> Velocity
! conversion required for his purpose.
!
! The FITS convention differs from that of GILDAS, where the axis
! is truely dual, with the Rest Frequency and Source velocity matching
! at the reference channel. Frequencies are in the SOURCE reference
! frame, which differ from the LSRK if the source velocity is non-zero.
!
! Thus to reconcile the GILDAS and UVFITS description, one must compute
! at what channel the Rest Frequency appears, and derive from this
! what source velocity would make it appear at the reference channel.
!
! Unfortunately, **some**  UVFITS files from CASA also use a keyword
! (VLSR, or VELO-LSR or VELREF) interpreted as a source velocity, for
! "information" only presumably. This must be ignored.
!
! The initial interpretation of CASA UVFITS file, which dated from our
! guesses about what CASA was actually doing (there is no description,
! we have to guess from the UVFITS definition papers, and the best
! reference seems to be AIPS memo 117), was incorrect. This led to
! incorrect velocity axes when importing such data in GILDAS.
! Since at least CASA 4.3.1, the new interpretation works.
!
! A remaining issue in the CASA-->UVFITS-->GILDAS chain is that baseline
! lengths are in the Topocentric frame, while Frequencies are in the LSR
! frame (usually). Evaluating the proper angular scale requires a
! knowledge of the Doppler effect at the time of the observations. This
! is not given in CASA UVFITS files.
!
! This Doppler effect is in general small (maximum value is less than
! 2x10^-4) so the effect is negligible in general (0.2 pixels at the
! edges of a 2048 x 2048 like map).
!
! The first order value of this is handled for GILDAS data as the "Doppler"
! factor, and implemented in UVFITS by the proper combination of the
! ZSOURCE, SSSYSRC and SSYSOBS keywords.
!
! CASA--GILDAS users should be aware of this current limitation.
!
! Ultimately, we could remove it by re-computing the Doppler effect when
! importing UVFITS files, but that requires access to the ephemeris, not
! available in kernel/lib/gio.  

! Command UV_DOPPLER in ASTRO does something similar, but is not finalized. 
! It would then be conceivable to use it in the "fits_to_uvt.map" procedure, 
! after importing ASTRO in MAPPING.  However, this also imports many 
! commands not really useful, or even with conflicting names.
! Splitting the ASTRO package in two parts
!  - "ephemeris", with only the generic ephemeris tools (TIME,
!  - "astro" itself, with all the specific Observatory tools (LINE, BACKENDS,
! could be a solution, but is time consuming, and error prone.
!
! An other alternative is a task, but it adds the overhead of a "fork",
! which can be serious on memory limited computers.
!
! A better solution is implemented in IMAGER through command UV_ADD DOPPLER.
! It is functional, but hardly ever used.
!
!-----------------------------------------------------------------------

end subroutine touvt
!
subroutine read_uvfits(fits,astoke,error,eot,pcount)
  use image_def
  use gbl_format
  use gbl_message
  use image_def
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>read_uvfits
  use gio_fitsdef
  !---------------------------------------------------------------------
  ! @ private
  !   Read all the input FITS UV table
  !---------------------------------------------------------------------
  type(gildas),    intent(inout) :: fits    !
  integer(kind=4), intent(in)    :: astoke  ! Stokes parameter
  logical,         intent(out)   :: error   ! Error flag
  logical,         intent(out)   :: eot     ! End ot Tape flag
  integer(kind=4), intent(in)    :: pcount  ! Daps count
  ! Local
  character(len=*), parameter :: rname='TOUVT'
  character(len=message_length) :: mess
  character(len=1) :: cstoke
  real(kind=4), parameter :: ps=1.0e-6 ! Because GILDAS uses MHz
  logical :: err, do_stokes
  integer(kind=4) :: jv,ib,inchan,onchan,nblock,stbl
  real(kind=4) :: ws
  real(kind=4), allocatable :: inarray(:), outarray(:,:)
  integer(kind=4), allocatable :: in_stokes(:)
  integer(kind=4) :: in_nstokes, insize, stokes_order
  real(kind=4) :: trail, mtrail, rinte, indaps(7)
  integer(kind=4) :: ier, nt, i, lc
  ! 
  integer(kind=index_length) :: ngood, nflag, nempty, kv, iblc, idim, itrc
  logical :: good, needs_good
  !
  ! Prepare reading of the visibilities
  rinte = 0       ! Integration time
  eot = .false.   ! Otherwise, error on Ifort
  err = .false.   ! Make sure it is initialized
  error = .false.
  call gfits_flush_data(error)
  if (error) return
  fd%nb = 2881
  !
  !!! call gdf_print_header(fits)
  mtrail = 0
  !
  call gdf_nitems('SPACE_GILDAS',nblock,fits%gil%dim(1)) ! Visibilities at once
  nblock = min(nblock,fits%gil%dim(2))
  !
  ! Optionally change the Stokes parameters
  in_nstokes = fits%gil%nstokes
  allocate(in_stokes(in_nstokes))
  in_stokes(:) = fits%gil%stokes(1:in_nstokes)
  !
  ! Keep all Stokes only if Astoke is 0 or all 4 Stokes present
  if (in_nstokes.eq.4) then
    if (astoke.ne.0) then
      call gio_message(seve%w,'FITS','Keeping all 4 stokes parameters')
    endif
  else if (astoke.ne.0) then
    if (in_nstokes.gt.1) then
      call gio_message(seve%i,'FITS','Treating signal as unpolarized')
    endif
    fits%gil%nstokes = 1
    fits%gil%stokes(1) =  code_stokes_none
    stokes_order = fits%gil%order
    fits%gil%order = 0                        ! No order if only 1 Stokes
  else
    if (in_nstokes.gt.1) then
      cstoke = char(in_nstokes+ichar('0'))
      call gio_message(seve%w,'FITS','Keeping all '//cstoke//' stokes parameters')
    endif
  endif
  !
  if (in_nstokes.eq.fits%gil%nstokes) then
    allocate(outarray(fits%gil%dim(1),nblock),inarray(fits%gil%dim(1)),stat=ier)
    inchan = fits%gil%nchan*fits%gil%nstokes
    onchan = inchan
  else
    ! Change a number of sizes and properly shift the Column Pointers
    ! before creating the data file
    onchan = fits%gil%nchan*fits%gil%nstokes
    inchan = fits%gil%nchan*in_nstokes
    insize = fits%gil%nlead + inchan*3 + fits%gil%ntrail
    fits%gil%dim(1) = (fits%gil%nlead + onchan*3 + fits%gil%ntrail)
    allocate(outarray(fits%gil%dim(1),nblock),inarray(insize),stat=ier)
    !
    ! Shift trailing columns
    if (fits%gil%ntrail.ne.0) then
      ! This is a generic code 
      do i=1,code_uvt_last
       if (fits%gil%column_pointer(i).gt.fits%gil%nlead) then
          fits%gil%column_pointer(i) = fits%gil%column_pointer(i) + 3*(onchan-inchan)
        endif
      enddo
    endif
  endif
  if (ier.ne.0) then
    call gio_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  lc = fits%gil%dim(1)-fits%gil%ntrail
  !
  ! Write the sections
  !
  if (fits%gil%nstokes.gt.1) then
    stbl = gdf_stbl_get()
    if (stbl.ne.2) call gdf_stbl(2,err)
  else
    stbl = 2
  endif
  !
  call gdf_create_image(fits,error)
  if (error) then
    call gio_message(seve%e,rname,'Image not created')
    if (stbl.ne.2) call gdf_stbl(stbl,err)
    return
  endif
  !
  ws = wps * ps                ! Final weight scaling factor
  !
  ! This code is NOT generic. It assumes the code_uvt_id (or equivalent)
  ! just follows the last channel, and is the only copied trailing column...
  if (fits%gil%ntrail.eq.0) then
    nt = 0
  else
    nt = 7+3*onchan+1
  endif
  fits%blc(1) = 1
  fits%trc(1) = fits%gil%dim(1)
  fits%blc(2) = 0
  fits%trc(2) = 0
  error = .false.
  !
  if (in_nstokes.eq.fits%gil%nstokes) then
    if (in_nstokes.gt.1) call gio_message(seve%w,rname,'Keeping all Stokes parameters')
    do_stokes = .false.
    needs_good = .true.   ! Test ...
  else
    call gio_message(seve%w,rname,'Extracting unpolarized signal')
    do_stokes = .true.
    needs_good = .false.  ! Test itou...
  endif
  !
  ngood = 0
  nflag = 0
  nempty = 0
  !
  ! Input sizes
  idim = fits%gil%dim(2)
  itrc = 0
  !
  do ib = 1, idim, nblock
    iblc = itrc+1
    itrc = min(idim,itrc+nblock)
    !
    kv = 0  ! Output counter
    !
    write(mess,'(A,I9,A,I9,A,I9,A,I0,A)') &
         & 'Reading ',iblc,' to ', itrc, &
         & ' / ',idim,' (',nint((100.*itrc)/idim),'%)'
    call gio_message(seve%i,rname,mess)
    do jv = 1,itrc-iblc+1 !! fits%trc(2)-fits%blc(2)+1
      good = needs_good
      call read_visi (indaps,inarray,inchan,ws,error,pcount,trail,rinte,good)
      if (error) goto 100
      !
      if (good) then
        kv = kv+1
        ! Daps
        outarray(1:7,kv) = indaps 
        ! Visibilities
        if (do_stokes) then
          call uvfits_stokes_select(inarray,inchan,outarray(8:lc,kv),onchan, &
            & in_nstokes,in_stokes,fits%gil%stokes(1),stokes_order)
        else
          outarray(8:lc,kv) = inarray
        endif
        ! Trailing column (only 1 so far, assumed to be Source ID...)
        if (nt.ne.0) then
          outarray(nt:nt,kv) = trail
          mtrail = max(mtrail,trail)
        endif
        ngood = ngood+1
      else
        nflag = nflag+1
      endif
    enddo
    !
    if (kv.ne.0) then
      fits%blc(2) = fits%trc(2)+1
      fits%trc(2) = fits%trc(2)+kv
      !! Print *,'Writing block ',fits%blc(2),fits%trc(2)
      call gdf_write_data(fits,outarray,error)
      if (error) goto 100
    else
      nempty = nempty+1
    endif
  enddo
  write(mess,'(A,I9,A)') 'Wrote   ',ngood,' visibilities'
  call gio_message(seve%i,rname,mess)
  !
  ! If some data has been ignored, say it and update visibility number
  if (nempty.gt.0) then
    write(mess,'(I0,A)') nempty ,' input blocks were empty'
    call gio_message(seve%w,rname,mess)
  endif
  if (nflag.gt.0) then
    write(mess,'(A,I9,A)') 'Ignored ',nflag,' flagged visibilities'
    call gio_message(seve%w,rname,mess)
    fits%gil%nvisi = ngood  ! This is needed but not sufficient...
    fits%gil%dim(2) = ngood ! so it is better to also change the array size 
    call gdf_update_header(fits,error)
  endif
  if (fits%gil%nstokes.gt.1)  call gio_message(seve%w,rname, &
      &   'More than 1 Stokes parameter, use STOKES command after')
!
100 continue
  if (stbl.ne.2) call gdf_stbl(stbl,err)
  !
  if (nt.ne.0) then
    !
    ! Mtrail contains the largest Source ID, i.e. the number of sources
    if (mtrail.le.1) then
      call gio_message(seve%w,rname,'Only one source found in MultiSource UVFITS file')
      ! We could (and perhaps should) set these to 0,
      ! since the information is to be ignored. But that would mean
      ! undefined trailing columns in the UV data.
      !! fits%gil%column_pointer(code_uvt_id) = fits%gil%dim(1)-1
      !! fits%gil%column_size(code_uvt_id) = 1
    endif
    !! Needed only in case we update the Pointers.
    !! call gdf_update_header(fits,error)
  endif
  call gdf_close_image(fits,err)  ! To free the allocated slot
  error = err.or.error
end subroutine read_uvfits
!
subroutine key_order(pcount,syst)
  use gio_fitsdef
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !    Define the scaling factors for each parameter
  !    and find out the ordering of the required Daps
  !---------------------------------------------------------------------
  integer, intent(in) :: pcount         ! Parameter count
  character(len=*), intent(in) :: syst  ! Coordinate system
  ! Local
  integer :: i
  real(8), parameter :: c=299792458.d0  ! Speed of light
  character(len=80) :: mess
  !
  luu = 0
  lvv = 0
  lww = 0
  ldate = 0
  ltime = 0
  lbase = 0
  lsour = 0
  lfreq = 0
  linte = 0
  !
  do i=1,pcount
    !
    ! There are things like UU--SIN
    if (ptype(i)(1:2).eq.'UU') then
      luu = i
      pscal(i) = c*pscal(i)
      pzero(i) = c*pzero(i)
    elseif (ptype(i)(1:2).eq.'VV') then
      lvv = i
      pscal(i) = c*pscal(i)
      pzero(i) = c*pzero(i)
    elseif (ptype(i)(1:2).eq.'WW') then
      lww = i
      pscal(i) = c*pscal(i)
      pzero(i) = c*pzero(i)
      !
      ! Date / Time can be in two parts
    elseif (ptype(i).eq.'DATE') then
      if (ldate.eq.0) then
        ldate = i
      else
        ltime = i
      endif
    elseif (ptype(i).eq.'TIME') then
      ltime = i
      !
      ! This is sometimes also written 'BASELINE'
    elseif (ptype(i)(1:4).eq.'BASE') then
      lbase = i
      ! Attempt to handle multi-source data
    elseif (ptype(i).eq.'SOURCE') then
      call gio_message(seve%w,'UVFITS','Possible Multi source data: support is limited')
      if (syst.ne.' ') then
        call gio_message(seve%w,'UVFITS','Pointing Center already set from OBSRA & OBSDEC')
        lsour = 0
      else
        call gio_message(seve%w,'UVFITS','Multi source data: RA and DEC may not be initialized')
        lsour = i
      endif
    elseif (ptype(i).eq.'INTTIM') then
      linte = i
    elseif (ptype(i).eq.'FREQSEL') then
      lfreq = i
    else
      write(mess,*) 'Unknown PTYPE ',ptype(i),' for column ',i
      call gio_message(seve%w,'UVFITS',mess)
    endif
  enddo
  !
  ! Use Offset between GAG_DATE and MJD
  if (ldate.ne.0) then
    pzero(ldate) = pzero(ldate) -  2460549.5d0
  endif
end subroutine key_order
!
subroutine read_visi(daps,visi,nchan,ps,error,pcount,trail,rinte,good)
  use gildas_def
  use gio_interfaces, only : gio_message
  use gio_fitsdef
  use gbl_message
  !---------------------------------------------------------------------
  ! @ no-interface (because of output array re-shaping)
  !
  ! FITS  Internal routine.
  !       Read one visibility from FITS file.
  !---------------------------------------------------------------------
  real,    intent(out)   :: daps(7)        ! Data Associated Parameters
  integer, intent(in)    :: nchan          ! Number of "channels"
  real,    intent(out)   :: visi(3,nchan)  ! Visibilities
  real,    intent(in)    :: ps             ! Weight scaling factor
  logical, intent(inout) :: error          ! Error flag
  integer, intent(in)    :: pcount         ! Parameter count
  real,    intent(inout) :: trail          ! trailing array
  real,    intent(inout) :: rinte          ! integration time (if any)
  logical, intent(inout) :: good           ! Input: keep all the channels? Output: kept any good channel?
  ! Local
  integer, parameter :: mdap=20     ! Must be > 8
  real :: udaps(mdap)
  integer :: i
  integer(kind=size_length) :: vsize
  real :: dummy
  character(len=60) :: chain
  !
  ! Get daps
  vsize = 1
  do i=1,min(mdap,pcount)
    call gfits_getreal(fd,vsize,udaps(i),pscal(i),pzero(i),error)
  enddo
  !
  ! Sort them
  daps(1) = udaps(luu)
  daps(2) = udaps(lvv)
  daps(3) = udaps(lww)
  if (ltime.ne.0) then
    daps(4) = int(udaps(ldate))    ! In days
    daps(5) = (dble(udaps(ldate)-daps(4)) +  &
               dble(udaps(ltime)))*86400.d0  ! In seconds
  else
    daps(4) = int(udaps(ldate))
    daps(5) = (dble(udaps(ldate))-daps(4))*86400.d0
  endif
  daps(6) = int(udaps(lbase))/256
  daps(7) = nint(udaps(lbase)-256*daps(6))
  !
  ! Skip any other information
  vsize = 1
  do i=mdap+1,pcount
    call gfits_getreal(fd,vsize,dummy,1.0,dzero,error)  ! DUMMY READ
  enddo
  !
  ! Get data
  vsize = 3*nchan
  call gfits_getreal(fd,vsize,visi,cscal,czero,error)    ! Data & Weight
  !
  ! Scale weights
  if (good) then
    do i=1, nchan
      ! This implies writing Flagged data...
      visi(3,i) = visi(3,i)*ps  ! Weight is positive or negative ...
    enddo
  else
    do i=1, nchan
      ! Ignore Flagged data...
      if (visi(3,i).gt.0.) then
        visi(3,i) = visi(3,i)*ps  ! Weight is positive
        good = .true.
      else
        visi(1,i) = 0
        visi(2,i) = 0
      endif
    enddo
  endif
  if (error) then
    call gio_message(seve%e,'UVFITS','Error in READ_VISI')
  endif
  !
  if (lsour.ne.0) then
    trail = udaps(lsour)
  endif
  !
  if (linte.ne.0) then
    if (rinte.eq.0.0) then
      rinte = udaps(linte)
      write(chain,*) 'Integration time is ',rinte
      call gio_message(seve%i,'UVFITS',chain)
    elseif (rinte.ne.udaps(linte)) then
      rinte = udaps(linte)
      write(chain,*) 'Integration time changed to ',rinte
      call gio_message(seve%w,'UVFITS',chain)
    endif
  endif
  if (lfreq.ne.0) then
    if (udaps(lfreq).ne.1.0) then
      call gio_message(seve%e,'UVFITS','More than 1 Frequency setup - unsupported')
    endif
  endif
end subroutine read_visi
!
subroutine gio_setistbl(is,stbl)
  use gio_image
  !--------------------------------------------------------
  ! @ private
  ! Temporary routine to set the Number of Header blocks
  ! Use by FITS interface to support Ntsokes > 1.
  !--------------------------------------------------------
  integer, intent(in) :: is     ! Image slot number
  integer, intent(in) :: stbl   ! Number of header blocks
  !
  istbl(is) = stbl
end subroutine gio_setistbl
!
function stokes_from_fits(rfits)
  use image_def
  !--------------------------------------------------------
  ! @ public
  !
  ! Here we decode the Stokes convention from the FITS Header
  ! -8  -7  -6  -5  -4  -3  -2  -1   0   1   2   3   4
  ! YX  XY  YY  XX  LR  RL  LL  RR  None I   Q   U   V
  !--------------------------------------------------------
  !
  integer :: stokes_from_fits
  real, intent(in) :: rfits
  !
  integer :: jfits(-8:4)
  integer :: jgdf(-8:4)
  integer :: kfits
  !
  data jfits/-8,-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4/
  data jgdf/code_stokes_yx,code_stokes_xy,code_stokes_yy,code_stokes_xx, &
       & code_stokes_lr,code_stokes_rl,code_stokes_ll,code_stokes_rr, &
       & code_stokes_none,code_stokes_i,code_stokes_q,code_stokes_u,code_stokes_v/
  kfits = nint(rfits)
  if (kfits.ge.-8.and.kfits.le.4) then
    stokes_from_fits = jgdf(kfits)
  else
    stokes_from_fits = code_stokes_none
  endif
end function stokes_from_fits
!
function fits_from_stokes(istoke)
  use image_def
  !--------------------------------------------------------
  ! @ public
  !
  ! Here we decode the Stokes convention from the FITS Header
  ! -8  -7  -6  -5  -4  -3  -2  -1  0    1   2   3   4
  ! YX  XY  YY  XX  LR  RL  LL  RR  None I   Q   U   V
  !--------------------------------------------------------
  !
  integer :: fits_from_stokes
  integer, intent(in) :: istoke
  !
  integer :: jfits(13)
  integer :: jgdf(13)
  integer :: i
  !
  data jfits/-8,-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4/
  data jgdf/code_stokes_yx,code_stokes_xy,code_stokes_yy,code_stokes_xx, &
       & code_stokes_lr,code_stokes_rl,code_stokes_ll,code_stokes_rr, &
       & code_stokes_none,code_stokes_i,code_stokes_q,code_stokes_u,code_stokes_v/
  !
  fits_from_stokes = code_stokes_none
  do i=1,13
    if (istoke.eq.jgdf(i)) then
      fits_from_stokes=jfits(i)
      return
    endif
  enddo
end function fits_from_stokes
!
!
subroutine uvfits_stokes_select(inarray,inchan,outarray,onchan, &
  & nstokes,in_stokes,out_stokes,stokes_order)
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !   GIO   perform the appropriate Stokes conversion
  !---------------------------------------------------------------------
  integer, intent(in) :: inchan             ! Input number of channels
  real, intent(in) :: inarray(3,inchan)     ! Input visibilitiees
  integer, intent(in) :: onchan             ! Output number of channels
  real, intent(out) :: outarray(3,onchan)   ! Output visibilities
  integer, intent(in) :: nstokes            ! Number of input Stokes
  integer, intent(in) :: in_stokes(nstokes) ! Input Stokes codes
  integer, intent(in) :: out_stokes         ! Output Stokes
  integer, intent(in) :: stokes_order       ! Stokes ordering
  !
  integer :: i,j
  real :: wa, wb
  !
  ! Extract or Compute the out_stokes parameter from the 
  ! in_stokes(nstokes) input parameters.
  !
  if (nstokes.eq.2) then
    ! This assumes (but it is customary) that we have
    ! 2 stokes, either XX,YY or RR,LL or even HH,VV as input
    if (stokes_order.eq.code_stok_chan) then
      if (out_stokes.eq.code_stokes_i) then
        j = 1
        do i=1,onchan
          if (inarray(3,j).gt.0 .and. inarray(3,j+1).gt.0) then
            outarray(1:2,i) = 0.5*(inarray(1:2,j)+inarray(1:2,j+1))
            outarray(3,i) = 4*inarray(3,j)*inarray(3,j+1)/(inarray(3,j)+inarray(3,j+1))
          else
            outarray(1:3,i) = 0.
          endif
          j = j+2
        enddo
      else if (out_stokes.eq.code_stokes_none) then
        ! None: can pick any unflagged data
        j = 1
        do i=1,onchan
          wa = max(0.,inarray(3,j))
          wb = max(0.,inarray(3,j+1))
          outarray(3,i) = wa+wb
          !
          if (outarray(3,i).ne.0) then
            outarray(1:2,i) = ( inarray(1:2,j)*wa + &
              & inarray(1:2,j+1)*wb ) / outarray(3,i)
          else
            outarray(1:2,i) = inarray(1:2,j)+inarray(1:2,j+1)
          endif
          j = j+2
        enddo
      else if (out_stokes.eq.in_stokes(1)) then
        j = 1
        do i=1,onchan
          outarray(1:3,i) = inarray(1:3,j)
          j = j+2
        enddo
      else if (out_stokes.eq.in_stokes(2)) then
        j = 2
        do i=1,onchan
          outarray(1:3,i) = inarray(1:3,j)
          j = j+2
        enddo
      endif
    else if (stokes_order.eq.code_chan_stok) then
      if (out_stokes.eq.code_stokes_i) then
        do i=1,onchan
          outarray(1:3,i) = inarray(1:3,i)+inarray(1:3,i+onchan)
        enddo
      else if (out_stokes.eq.code_stokes_none) then
        do i=1,onchan
          wa = max(0.,inarray(3,i))
          wb = max(0.,inarray(3,i+onchan))
          outarray(3,i) = wa+wb
          if (outarray(3,i).ne.0) then
            outarray(1:2,i) = ( inarray(1:2,i)*wa + &
              & inarray(1:2,i+onchan)*wb ) / outarray(3,i)
          else
            outarray(1:2,i) = inarray(1:2,i)+inarray(1:2,i+onchan)
          endif
          j = j+1
        enddo
      else if (out_stokes.eq.in_stokes(1)) then
        do i=1,onchan
          outarray(1:3,i) = inarray(1:3,i)
        enddo
      else if (out_stokes.eq.in_stokes(2)) then
        do i=1,onchan
          outarray(1:3,i) = inarray(1:3,i+inchan)
        enddo
      endif
    endif
  else if (nstokes.eq.4) then
    ! It must be the I,Q,U,V   values as input,
    ! or XX, YY, XY, YX
    ! or RR, LL, RL, LR
    ! or (but this never happens) HH, VV, HV, VH
    !
    ! and STOKES_NONE as output
    if (out_stokes.eq.code_stokes_none) then
      !
      ! We might sum up the first 2 values XX + YY or LL + RR or take I or None as above.
      call gio_message(seve%e,'FITS','4 Stokes to Unpolarized not yet coded')
      call sysexi(fatale)
    else
      call gio_message(seve%e,'FITS','Dont know yet how to handle 4 Stokes - Really Sorry')
      call sysexi(fatale)
    endif
  endif
  !
end subroutine uvfits_stokes_select
