PROGRAM test1

!     Test vmove.
!     The LS fit to the data is:  Y = 1 + X + X**2 + X**3
!     i.e. all of the regression coefficients should be exactly 1.0.
!     An extra variable equal to X + X**2 is inserted to give a singularity.

USE lsq
IMPLICIT NONE

REAL ( lsq_kind ) :: x(11,4), y(11), xrow(5), yelem, beta(5), one = 1.D0
INTEGER           :: nvar, i, j, ifault
LOGICAL           :: fit_const, lindep(5)
CHARACTER (LEN=1) :: key

DATA y/65647., 70638., 75889., 81399., 87169., 93202., 99503., &
       106079., 112939., 120094., 127557./

WRITE(*, *)'Fitting nasty cubic'
WRITE(*, *)'1st 4 regression coefficients should equal 1.0'
WRITE(*, *)'Last variable = X + X^2, to introduce a deliberate singularity'
WRITE(*, *)

DO i = 1, 11
  x(i,1) = i + 39
  x(i,2) = x(i,1)**2
  x(i,3) = x(i,1) * x(i,2)
  x(i,4) = x(i,1) + x(i,2)
END DO

!     Use includ to form the orthogonal reduction.

nvar = 4
fit_const = .true.
CALL startup(nvar, fit_const)

DO i = 1, 11
  xrow(1) = one
  DO j = 1, 4
    xrow(j+1) = x(i,j)
  END DO
  yelem = y(i)
  CALL includ(one, xrow, yelem)
END DO

!     CALL tolset to set tolerances, then sing to detect singularities.

CALL tolset
CALL sing(lindep, ifault)
WRITE(*, *)'From routine SING, IFAULT =', ifault
WRITE(*, *)'Array LINDEP:', lindep
WRITE(*, *)
WRITE(*, *)'sserr = ', sserr, '   Should be 286.000'

!     Calculate residual sums of squares (RSS).

      CALL ss

!     Calculate regression coefficients, using vmove to cycle through
!     the order of the variables.

    DO i = 1, 6
      CALL regcf(beta, 5, ifault)
      WRITE(*, 920) vorder
920   FORMAT(1x, 'Variable order:'/ 1x, i10, 4i15)
      WRITE(*, 900) beta
900   FORMAT(' Regn. coeffs.:'/ 4x, 5g15.7)
      WRITE(*, 910) d, r, rhs, rss
910   FORMAT(' d: ', 5g15.7/ ' r: ', 4g15.7/19x,3g15.7/34x,2g15.7/ &
          49x,g15.7/ ' rhs: '/4x, 5g15.7/ ' rss: '/4x, 5g15.7//)

WRITE(*, *)'Press ENTER to continue'
READ(*, '(a)') key

!     Move variable in 1st position to the last.

      CALL vmove(1, 5, ifault)
    END DO
END PROGRAM test1