C SUBROUTINE POLFIT.F 
C
C SOURCE
C   BEVINGTON, PAGES 140-142.
C
C PURPOSE
C   MAKE A LEAST-SQUARES FIT TO DATA WITH A POLYNOMIAL CURVE
C      Y = A(1) + A(2)*X + A(3)*X**2 + A(3)*X**3 + . . .
C
C USAGE 
C   CALL POLFIT (X, Y, SIGMAY, NPTS, NTERMS, MODE, A, CHISQR)
C
C DESCRIPTION OF PARAMETERS
C   X	   - ARRAY OF DATA POINTS FOR INDEPENDENT VARIABLE
C   Y	   - ARRAY OF DATA POINTS FOR DEPENDENT VARIABLE
C   SIGMAY - ARRAY OF STANDARD DEVIATIONS FOR Y DATA POINTS
C   NPTS   - NUMBER OF PAIRS OF DATA POINTS
C   NTERMS - NUMBER OF COEFFICIENTS (DEGREE OF POLYNOMIAL + 1)
C   MODE   - DETERMINES METHOD OF WEIGHTING LEAST-SQUARES FIT
C	     +1 (INSTRUMENTAL) WEIGHT(I) = 1./SIGMAY(I)**2
C	      0 (NO WEIGHTING) WEIGHT(I) = 1.
C	     -1 (STATISTICAL)  WEIGHT(I) = 1./Y(I)
C   A	   - ARRAY OF COEFFICIENTS OF POLYNOMIAL
C   CHISQR - REDUCED CHI SQUARE FOR FIT 
C
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 
C   DETERM (ARRAY, NORDER)
C      EVALUATES THE DETERMINANT OF A SYMETRICAL
C      TWO-DIMENSIONAL MATRIX OF ORDER NORDER
C
C COMMENTS
C   DIMENSION STATEMENT VALID FOR NTERMS UP TO 10
C
      SUBROUTINE POLFIT (X,Y,SIGMAY,NPTS,NTERMS,MODE,A,CHISQR)
	  implicit double precision (A-H,O-Z)
c        DOUBLE PRECISION SUMX,SUMY,XTERM,YTERM,ARRAY,CHISQ
	  DIMENSION X(1),Y(1),SIGMAY(1),A(1)
	  DIMENSION SUMX(19),SUMY(10),ARRAY(10,10)
C
C ACCUMULATE WEIGHTED SUMS
C
11	NMAX=2*NTERMS-1 
	DO 13 N=1,NMAX
13	SUMX(N)=0.d0
	DO 15 J=1,NTERMS
15	SUMY(J)=0.d0
	CHISQ=0.d0
21	DO 50 I=1,NPTS
	XI=X(I) 
	YI=Y(I) 
31	IF (MODE) 32,37,39
32	IF (YI) 35,37,33
33	WEIGHT=1./YI
	GOTO 41 
35	WEIGHT=1.d0/(-YI) 
	GOTO 41 
37	WEIGHT=1.d0
	GOTO 41 
39	WEIGHT=1.d0/SIGMAY(I)**2
41	XTERM=WEIGHT
	DO 44 N=1,NMAX
	SUMX(N)=SUMX(N)+XTERM
44	XTERM=XTERM*XI
45	YTERM=WEIGHT*YI 
	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 AND CALCULATE COEFFICIENTS 
C
51	DO 54 J=1,NTERMS
	DO 54 K=1,NTERMS
	N=J+K-1 
54	ARRAY(J,K)=SUMX(N)
	DELTA=DETERM (ARRAY,NTERMS)
	IF (DELTA) 61,57,61
57	CHISQR=0.d0
	DO 59 J=1,NTERMS
59	A(J)=0.d0 
	GOTO 80 
61	DO 70 L=1,NTERMS
62	DO 66 J=1,NTERMS
	DO 65 K=1,NTERMS
	N=J+K-1 
65	ARRAY(J,K)=SUMX(N)
66	ARRAY(J,L)=SUMY(J)
70	A(L)=DETERM (ARRAY,NTERMS) /DELTA
C
C CALCULATE CHI SQUARE
C
71	DO 75 J=1,NTERMS
	CHISQ=CHISQ-2.d0*A(J)*SUMY(J)
	DO 75 K=1,NTERMS
	N=J+K-1 
75	CHISQ=CHISQ+A(J)*A(K)*SUMX(N)
76	FREE=NPTS-NTERMS
77	CHISQR=CHISQ/FREE
80	RETURN
	END
