SUBROUTINE POLFIT(X,Y,S,NPTS,NTERM,MODE,A,CHISQR) c c Fit a polynomial to X,Y,S of NPTST c NTERM must not be greater than 10 c See Bevington for further details c REAL X(NPTS),Y(NPTS),S(NPTS),A(NTERM) REAL*8 SUMX(19),SUMY(10),ARRAY(100) REAL*8 XTERM,YTERM,CHISQ DO 10 I = 1,NTERM 10 A(I) = 0 ! Zero the array A CHISQR = 0. NTERMS = NTERM IF(NTERMS .GT. 10)NTERMS = 10 IF(NTERMS .GE. NPTS)NTERMS = NPTS - 1 NMAX = 2*NTERMS - 1 DO 12 I = 1,19 12 SUMX(I) = 0 DO 13 I = 1,10 13 SUMY(I) = 0 DO 14 I = 1,100 14 ARRAY(I) = 0 CHISQ = 0. XSAV = 0. DO 20 I = 1,NPTS IF(XSAV .GT. ABS(X(I)) )GO TO 20 XSAV = ABS(X(I)) 20 CONTINUE XSAV = XSAV/1.5 DO 50 I = 1,NPTS XI = X(I)/XSAV YI = Y(I) IF(MODE) 32,37,39 32 WEIGHT = 1./(.5 + ABS(YI) ) GO TO 41 37 WEIGHT = 1. GO TO 41 39 WEIGHT = 1./S(I)**2 41 XTERM = WEIGHT DO 44 N = 1,NMAX SUMX(N) = SUMX(N) + XTERM 44 XTERM = XTERM * XI YTERM = WEIGHT* YI YT = WEIGHT* XT DO 48 N = 1,NTERMS SUMY(N) = SUMY(N) + YTERM 48 YTERM = YTERM * XI 49 CHISQ = CHISQ + WEIGHT*YI**2 50 CONTINUE C C CONSTRUCT MATRICES + CALCULATE COEFFICIENTS C DO 54 J = 1,NTERMS DO 54 K = 0,NTERMS-1 N = J + K M = J + NTERMS*K 54 ARRAY(M) = SUMX(N) DELTA = DDETRM(ARRAY,NTERMS) IF(ABS(DELTA) .LT. 1.E-30)RETURN 61 DO 70 L = 1,NTERMS DO 66 J = 1,NTERMS DO 65 K = 0,NTERMS-1 N = J + K M = J + NTERMS*K 65 ARRAY(M) = SUMX(N) M = J + NTERMS*(L-1) 66 ARRAY(M) = SUMY(J) 70 A(L) = DDETRM(ARRAY,NTERMS) /( XSAV**(L-1) * DELTA ) C C CALCULATE CHI SQUARE C DO 75 J = 1,NTERMS CHISQ = CHISQ - 2.*A(J)*SUMY(J)*XSAV**(J-1) DO 75 K = 1,NTERMS N = J + K - 1 75 CHISQ = CHISQ + A(J)*A(K)*SUMX(N)*XSAV**(J+K-2) CHISQR = CHISQ / (NPTS - NTERMS) RETURN END