subroutine polyant(iy, m, nbas, iant, jant, iref,   &
    kplus1, nant, x, y, w,   &
    wk1, wk2, wk3, ss, wss, c, error)
  !---------------------------------------------------------------------
  !     polyant computes a weighted least-squares polynimial approximation
  !     to the antenna amplitudes or phases
  !     for an arbitrary set of baseline data points.
  ! parameters:
  !     iy             I   Input    1 for log(amplitude), 2 for phase
  !     m              I   Input    the number of data points for each baseline
  !     nbas           I   Input    the number of baselines
  !     iant(nbas)     I   Input    start antenna for each baseline
  !     jant(nbas)     I   Input    end  antenna for each baseline
  !     iref           i   Input    Reference antenna for phases
  !     kplus1         I   Input    degree of polynomials + 1
  !     nant           I   Input    the number of antennas
  !     x(m)           R8  Input    the data abscissae
  !     y(m,nbas)      R8  Input    the data values
  !     w(m,mbas)      R8  Input    weights
  !     wk1(kplus1)    R8  Output   work space
  !     wk2(kplus1**2*nant**2)
  !                    R8  Output   work space
  !     wk3(kplus1*nant)
  !                    R8  Output   work space
  !     ss(nbas)       R8  Output   rms of fit for each baseline
  !     c(nant,kplus1) R8  Output   the polynomial coefficients
  !---------------------------------------------------------------------
  integer :: iy                           !
  integer :: m                            !
  integer :: nbas                         !
  integer :: iant(nbas)                   !
  integer :: jant(nbas)                   !
  integer :: iref                         !
  integer :: kplus1                       !
  integer :: nant                         !
  real*8 :: x(m)                          !
  real*8 :: y(m,nbas)                     !
  real*8 :: w(m,nbas)                     !
  real*8 :: wk1(kplus1)                   !
  real*8 :: wk2(kplus1*nant,kplus1*nant)  !
  real*8 :: wk3(kplus1*nant)              !
  real*8 :: ss(nbas)                      !
  real*8 :: wss(nbas)                     !
  real*8 :: c(nant,kplus1)                !
  logical :: error                        !
  ! Global
  include 'gbl_pi.inc'
  ! Local
  real*8 :: norm, tol
  parameter (tol=1d-14)
  integer :: zant, i, ia, ib, nantm1, j
  integer :: ja, ic, il, kn, kp, k, l, iter
  real*8 ::  wi, xi, wn, ww, www, test, yi, xcap, x1, xn, d
  !------------------------------------------------------------------------
  ! Code
  !
  ! Check that the weights are positive.
  !
  do  i=1,m
    do ib = 1, nbas
      if (w(i,ib).lt.0.0d0) then
        call message(6,4,'POLYANT','Weights not positive')
        error = .true.
        return
      endif
    enddo
  enddo
  x1 = x(1)
  xn = x(m)
  d = xn-x1
  !
  ! Amplitude case is simple...
  !
  if (iy.eq.1) then
    do i=1,nant*kplus1
      do l=1,nant*kplus1
        wk2(l,i) = 0.0d0
      enddo
      wk3(i) = 0.0d0
    enddo
    do i=1, m
      xi = x(i)
      xcap = ((xi-x1)-(xn-xi))/d
      ! compute the chebychev polynomials at point xi.
      call cheb (kplus1, xcap, wk1, error)
      if (error) goto 999
      !
      ! store the upper-triangular part of the normal equations in wk2
      ! and the right-hand side in wk3.
      !
      do k=1, kplus1
        wn = wk1(k)
        il = (k-1)*nant
        do kp = 1, kplus1
          ww = wn*wk1(kp)
          ic = (kp-1)*nant
          do ib=1,nbas
            wi = w(i,ib)
            if (wi.gt.0) then
              ia = iant(ib)
              ja = jant(ib)
              www = wi*ww
              wk2(il+ia,ic+ia) = wk2(il+ia,ic+ia)+www
              wk2(il+ia,ic+ja) = wk2(il+ia,ic+ja)+www
              wk2(il+ja,ic+ia) = wk2(il+ja,ic+ia)+www
              wk2(il+ja,ic+ja) = wk2(il+ja,ic+ja)+www
            endif
          enddo
        enddo
        do ib=1, nbas
          ia = iant(ib)
          ja = jant(ib)
          wi = w(i,ib)*wn*y(i,ib)
          !                  wi = w(i,ib)*wn*xcap*(ja+ia) !**!
          wk3(il+ia) = wk3(il+ia) + wi
          wk3(il+ja) = wk3(il+ja) + wi
        enddo
      enddo
    enddo
    !
    ! Solve the system of normal equations by first computing the Cholesky
    ! factorization
    !
    call mth_dpotrf ('POLYANT',   &
      'U',kplus1*nant,wk2,kplus1*nant,error)
    if (error) goto 999
    call mth_dpotrs ('POLYANT',   &
      'U',kplus1*nant,1,wk2,kplus1*nant,   &
      wk3,kplus1*nant,error)
    if (error) goto 999
    do j=1,kplus1
      do i=1,nant
        c(i,j) = wk3(i+(j-1)*nant)
      enddo
    enddo
  !
  ! Phase is more complicated ...
  elseif (iy.eq.2) then
    nantm1 = nant-1
    do i=1,nant
      do j=1,kplus1
        c(i,j) = 0.0d0
      enddo
    enddo
    !
    ! start iterating
    norm = 1e10
    iter = 0
    do while (norm.gt.tol .and. iter.lt.100)
      iter = iter + 1
      do i=1,nantm1*kplus1
        do l=1,nantm1*kplus1
          wk2(l,i) = 0.0d0
        enddo
        wk3(i) = 0.0d0
      enddo
      do i=1, m
        xi = x(i)
        xcap = ((xi-x1)-(xn-xi))/d
        ! compute the chebychev polynomials at point xi.
        call cheb (kplus1, xcap, wk1, error)
        if (error) goto 999
        !
        do k=1, kplus1
          wn = wk1(k)
          il = (k-1)*nantm1
          do kp = 1, kplus1
            ww = wn*wk1(kp)
            ic = (kp-1)*nantm1
            do ib=1,nbas
              wi = w(i,ib)
              if (wi.gt.0) then
                ia = zant(iant(ib),iref)
                ja = zant(jant(ib),iref)
                www = wi*ww
                if (ia.ne.0) then
                  wk2(il+ia,ic+ia) = wk2(il+ia,ic+ia)+www
                endif
                if (ja.ne.0) then
                  wk2(il+ja,ic+ja) = wk2(il+ja,ic+ja)+www
                endif
                if (ia.ne.0 .and. ja.ne.0) then
                  wk2(il+ja,ic+ia) = wk2(il+ja,ic+ia)-www
                  wk2(il+ia,ic+ja) = wk2(il+ia,ic+ja)-www
                endif
              endif
            enddo
          enddo
          do ib=1, nbas
            if (w(i,ib).gt.0) then
              yi = y(i,ib)
              ia = iant(ib)
              ja = jant(ib)
              do kp=1, kplus1
                yi = yi+(c(ia,kp)-c(ja,kp))*wk1(kp)
              enddo
            !                  yi = xcap*(ja-ia) !**!
            else
              yi = 0
            endif
            !                     if (norm.lt.1e9) then
            yi = sin(yi)
            !                     endif
            ia = zant(iant(ib),iref)
            ja = zant(jant(ib),iref)
            wi = w(i,ib)*wn*yi
            if (ia.ne.0) then
              wk3(ia+il) = wk3(ia+il) - wi
            endif
            if (ja.ne.0) then
              wk3(ja+il) = wk3(ja+il) + wi
            endif
          enddo
        enddo
      enddo
      !            type *, ' wk2 '
      !            do j=1, kplus1*nantm1
      !               type *, j, (wk2(j,i),i=1,nantm1*kplus1)
      !            enddo
      !         type *, ' wk3 ',(wk3(i),i=1,nantm1*kplus1)
      !
      ! Solve the system of normal equations by first computing the Cholesky
      ! factorization
      call mth_dpotrf('POLYANT',   &
        'U',kplus1*nantm1,wk2,kplus1*nant,error)
      if (error) goto 999
      call mth_dpotrs ('POLYANT',   &
        'U',kplus1*nantm1,1,wk2,kplus1*nant,   &
        wk3,kplus1*nantm1,error)
      if (error) goto 999
      !         type *, ' wk3 ',(wk3(i),i=1,nantm1*kplus1)
      !
      !     Add the result to c:
      norm = 0
      do j=1,kplus1
        do ia=1,nant
          i = zant(ia,iref)
          if (i.ne.0) then
            ww = wk3(i+(j-1)*nantm1)
            c(ia,j) = c(ia,j)+ww
            norm = norm+ww**2
          endif
        enddo
      enddo
    !            write(6,*) 'norm' , norm
    enddo
  endif
  !      write(6,*) 'kplus1, j,(c(i,j),i=1, nant)'
  !      do j=1,kplus1
  !         write(6,*) kplus1, j,(c(i,j),i=1, nant)
  !      enddo
  !
  ! loop over data points to get rms
  do ib=1, nbas
    ss(ib) = 0
    wss(ib) = 0
  enddo
  do i = 1, m
    xi = x(i)
    xcap = ((xi-x1)-(xn-xi))/d
    call cheb (kplus1, xcap, wk1, error)
    if (error) goto 999
    do ib=1,nbas
      if (w(i,ib).gt.0) then
        ia = iant(ib)
        ja = jant(ib)
        test = 0
        do kn = 1, kplus1
          wn = wk1(kn)
          if (iy.eq.1) then
            test = test+(c(ia,kn)+c(ja,kn))*wn
          else
            test = test+(-c(ia,kn)+c(ja,kn))*wn
          endif
        enddo
        test = y(i,ib)-test
        if (iy.eq.2) test = mod(test+11*pi,2*pi)-pi
        ss(ib) = ss(ib)+w(i,ib)*test**2
        wss(ib) = wss(ib)+w(i,ib)
      endif
    enddo
  enddo
  do ib=1, nbas
    if (wss(ib).ne.0) then
      ss(ib) = sqrt(ss(ib)/wss(ib))
    else
      ss(ib) = 0
    endif
  enddo
  !      type *,' ss ',(ss(ib),ib=1, nbas)
  !      write(6,*) 'kplus1, j,(c(i,j),i=1, nant)'
  !      do j=1,kplus1
  !         write(6,*) kplus1, j,(c(i,j),i=1, nant)
  !      enddo
  !
  return
999 error = .true.
  return
end subroutine polyant
!
subroutine cheb(nplus1, xcap, p, error)
  !---------------------------------------------------------------------
  !  Compute nplus1 Chebishev Polynomials at x = xcap
  !---------------------------------------------------------------------
  integer :: nplus1                 !
  real*8 :: xcap                    !
  real*8 :: p(nplus1)               !
  logical :: error                  !
  ! Local
  real*8 :: bk, bkp1, bkp2, dk, eta, factor
  integer :: n, k
  !
  !     eta  is the smallest positive number such that
  !     the computed value of  1.0 + eta  exceeds unity.
  !          with NAG,  ETA = X02AAF(1.0D0)
  data eta/1.110223024625156d-16/
  !
  if (nplus1.lt.1) then
    write(6,*) 'F-CHEB, nplus1.lt.1'
    error = .true.
    return
  endif
  if (dabs(xcap).gt.1.0d0+4.0d0*eta) then
    write(6,*) 'F-CHEB, abs(xcap).gt.1'
  endif
  p(1) = 0.5d0
  if (nplus1.le.1) return
  n = nplus1 - 1
  k = n + 2
  if (xcap.lt.-0.5d0) then
    !
    ! Gentleman*s modified recurrence.
    factor = 2.0d0*(1.0d0+xcap)
    dk = -1.0d0
    bk = 0.0d0
    do  k=1,n
      dk = - dk + factor*bk
      bk = dk - bk
      p(k+1) = - dk + 0.5d0*factor*bk
    enddo
  elseif (xcap.le.0.5d0) then
    !
    ! Clenshaw*s original recurrence.
    !
    factor = 2.0d0*xcap
    bkp1 = 0.0d0
    bkp2 = -1.0d0
    do k=1,n
      bk = - bkp2 + factor*bkp1
      p(k+1) = - bkp1 + 0.5d0*factor*bk
      bkp2 = bkp1
      bkp1 = bk
    enddo
  else
    !
    ! Reinsch*s modified recurrence.
    !
    factor = 2.0d0*(1.0d0-xcap)
    dk = 1.0d0
    bk = 0.0d0
    do k=1,n
      dk = dk - factor*bk
      bk = bk + dk
      p(k+1) = dk - 0.5d0*factor*bk
    enddo
  endif
  p(1) = 0.5d0
  return
end subroutine cheb
