70 lines
2.0 KiB
Fortran
70 lines
2.0 KiB
Fortran
subroutine quadfit(xin,yin,ndata,poly)
|
|
|
|
! Polynomial to be fitted:
|
|
! Y = a(0) + a(1).X + a(2).X^2 + ... + a(m).X^m
|
|
|
|
USE lsq
|
|
IMPLICIT NONE
|
|
|
|
REAL*8 :: x(10000),y(10000),xrow(0:20), wt = 1.0, beta(0:20), &
|
|
var, covmat(231), sterr(0:20), totalSS, center
|
|
real*4 poly(3)
|
|
REAL*8 :: xin(10000), yin(10000)
|
|
INTEGER :: i, ier, iostatus, j, m, n, ndata
|
|
LOGICAL :: fit_const = .TRUE., lindep(0:20), xfirst
|
|
|
|
do i=1,ndata
|
|
y(i)=yin(i)
|
|
x(i)=xin(i)
|
|
end do
|
|
|
|
n=ndata
|
|
m=2
|
|
|
|
! Least-squares calculations
|
|
|
|
CALL startup(m, fit_const)
|
|
DO i = 1, n
|
|
xrow(0) = 1.0
|
|
DO j = 1, m
|
|
xrow(j) = x(i) * xrow(j-1)
|
|
END DO
|
|
CALL includ(wt, xrow, y(i))
|
|
END DO
|
|
|
|
CALL sing(lindep, ier)
|
|
IF (ier /= 0) THEN
|
|
DO i = 0, m
|
|
IF (lindep(i)) WRITE(*, '(a, i3)') ' Singularity detected for power: ', i
|
|
END DO
|
|
END IF
|
|
|
|
! Calculate progressive residual sums of squares
|
|
CALL ss()
|
|
var = rss(m+1) / (n - m - 1)
|
|
|
|
! Calculate least-squares regn. coeffs.
|
|
CALL regcf(beta, m+1, ier)
|
|
|
|
! Calculate covariance matrix, and hence std. errors of coeffs.
|
|
CALL cov(m+1, var, covmat, 231, sterr, ier)
|
|
poly(1)=beta(0)
|
|
poly(2)=beta(1)
|
|
poly(3)=beta(2)
|
|
|
|
!!$ WRITE(*, *) 'Least-squares coefficients & std. errors'
|
|
!!$ WRITE(*, *) 'Power Coefficient Std.error Resid.sum of sq.'
|
|
!!$ DO i = 0, m
|
|
!!$ WRITE(*, '(i4, g20.12, " ", g14.6, " ", g14.6)') &
|
|
!!$ i, beta(i), sterr(i), rss(i+1)
|
|
!!$ END DO
|
|
!!$
|
|
!!$ WRITE(*, *)
|
|
!!$ WRITE(*, '(a, g20.12)') ' Residual standard deviation = ', SQRT(var)
|
|
!!$ totalSS = rss(1)
|
|
!!$ WRITE(*, '(a, g20.12)') ' R^2 = ', (totalSS - rss(m+1))/totalSS
|
|
return
|
|
|
|
end subroutine quadfit
|
|
|