*DECK ALDFIT
      SUBROUTINE ALDFIT(N,MA,X,Y,W,PARAM)
*
*-----------------------------------------------------------------------
*
* PERFORMS LINEAR LEAST SQUARES FITTING TO A POLYNOMIAL OF A SPECIFIED
* ORDER IN ONE INDEPENDENT VARIABLE USING THE FORSYTHE METHOD.
*
* INPUT PARAMETERS:
*  N     : NUMBER OF DATA POINTS I.E., NUMBER OF X,Y VALUES.
*  MA    : INTEGER SPECIFYING THE ORDER OF THE POLYNOMIAL.
*  X     : ARRAY OF VALUES OF INDEP. VARIABLE. DOUBLE PRECISION X(N)
*  Y     : ARRAY OF VALUES OF DEPENDENT VARIABLE. DOUBLE PRECISION Y(N)
*  W     : ARRAY OF WEIGHTS. DOUBLE PRECISION W(N)
*
* OUTPUT PARAMETER:
*  PARAM : REAL ARRAY OF COEFFICIENTS OF THE FITTED POLYNOMIAL.
*          PARAM(I)=COEFF. OF X**I. DOUBLE PRECISION PARAM(0:MA)
*
*------------------------------------------------ AUTHOR: A. HEBERT ----
*
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      INTEGER N,MA
      DOUBLE PRECISION X(N),Y(N),W(N),PARAM(0:MA)
      DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: GAMMA,POLY,PP
*
      IF(MA.GE.N) CALL XABORT('ALDFIT: UNDER-DETERMINED SYSTEM.')
      AA=0.0D0
      BB=0.0D0
      CC=0.0D0
      DO 10 I=1,N
      AA=AA+W(I)*X(I)
      BB=BB+W(I)*Y(I)
   10 CC=CC+W(I)
      PARAM(0)=BB/CC
      IF(MA.EQ.0) RETURN
      ALLOCATE(GAMMA(MA,3),POLY(N,0:2),PP(0:MA,0:2))
      CALL XDDSET(POLY(1,0),N,1.0D0)
      GAMMA(1,1)=AA/CC
      GAMMA(1,2)=0.0D0
      AA=0.0D0
      BB=0.0D0
      DO 20 I=1,N
      POLY(I,1)=X(I)-GAMMA(1,1)
      AA=AA+W(I)*POLY(I,1)*Y(I)
   20 BB=BB+W(I)*POLY(I,1)**2
      GAMMA(1,3)=AA/BB
      DO 50 J=2,MA
      AA=0.0D0
      BB=0.0D0
      CC=0.0D0
      DD=0.0D0
      DO 30 I=1,N
      AA=AA+W(I)*X(I)*POLY(I,MOD(J-1,3))**2
      BB=BB+W(I)*POLY(I,MOD(J-1,3))**2
      CC=CC+W(I)*X(I)*POLY(I,MOD(J-1,3))*POLY(I,MOD(J-2,3))
      DD=DD+W(I)*POLY(I,MOD(J-2,3))**2
   30 CONTINUE
      GAMMA(J,1)=AA/BB
      GAMMA(J,2)=CC/DD
      AA=0.0D0
      BB=0.0D0
      DO 40 I=1,N
      POLY(I,MOD(J,3))=(X(I)-GAMMA(J,1))*POLY(I,MOD(J-1,3))-GAMMA(J,2)*
     1 POLY(I,MOD(J-2,3))
      AA=AA+W(I)*POLY(I,MOD(J,3))*Y(I)
   40 BB=BB+W(I)*POLY(I,MOD(J,3))**2
   50 GAMMA(J,3)=AA/BB
*
      DO 60 I=1,MA
      PP(I,0)=0.0D0
   60 PARAM(I)=0.0D0
      PP(0,0)=1.0D0
      DO 80 J=1,MA
      DO 70 I=0,MA
   70 PP(I,MOD(J,3))=0.0D0
      DO 80 I=0,J
      IF(I.LT.J) PP(I+1,MOD(J,3))=PP(I,MOD(J-1,3))
      PP(I,MOD(J,3))=PP(I,MOD(J,3))-PP(I,MOD(J-1,3))*GAMMA(J,1)
      IF(J.GT.1) PP(I,MOD(J,3))=PP(I,MOD(J,3))-PP(I,MOD(J-2,3))*
     1 GAMMA(J,2)
   80 PARAM(I)=PARAM(I)+PP(I,MOD(J,3))*GAMMA(J,3)
      DEALLOCATE(GAMMA,POLY,PP)
      RETURN
      END
