C
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CTITLESATAYL2 -- PERFORM LEAST MEAN-SQUARE POWER SERIES FITTING     `   00010001
CA    AUTHOR       B. S. BOK                                            00030001
CA    DESIGNER     B. S. BOK                                            00040001
CA    LANGUAGE     FORTRAN                                              00050001
CA    SYSTEM       IBM / CRAY                                           00060004
CA    WRITTEN      AUGUST, 1990                                         00070001
C     REVISED      12-21-91 JJC - MODIFIED TO MEET EDP STANDARDS.
C
CA                                                                      00150001
CA    CALL SATAYL2 (X, Y, W, LONG, ICODE, LF, F, WRK)
CA                                                                      00180000
CA         INPUT   X      = INDEPENDENT VARIABLE WITH LENGTH LONG   R4  00190003
CA         INPUT   Y      = DEPENDENT VARIABLE WITH LENGTH LONG     R4  00200003
CA         INPUT   W      = WEIGHTING FUNCTION                      R4  00200003
CA         INPUT   LONG   = NO. OF INPUT DATA POINTS                I4  00210003
CA         INPUT   ICODE  = 0 => AMPLITUDE WEIGHTING                I4  00210003
CA                        .NE. 0 => POWER WEIGHTING
CA         INPUT   LF     = NO. TERMS OF POWER SERIES               I4  00260007
CA                          (MUST BE .LE. 40)
CA         INPUT   WRK    = WORK ARRAY OF SIZE                      R4  00270004
CA                          (.GE. (2*LF+1)*LF )
CA         OUTPUT  F      = COEFS. OF POWER SERIES IN Y             R4
CA                          (Y= F(1) + F(2)*X + F(3)*X**2 )             00340000
CA                                                                      00350000
CA    THIS ROUTINE PERFORMS THE LEAST MEAN-SQUARE POWER SERIES FITTING  00360001
CA    WITH WEIGHTS                                                      00370001
CA                                                                      00510000
C**************************************************************
C                                                             *
C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE          *
C                                                             *
C SASYMIV                                                     *
C                                                             *
C**************************************************************
C
      SUBROUTINE SATAYL2 (X, Y, W, LONG, ICODE, LF, F, WRK)
C
      IMPLICIT INTEGER (A-Z)
C
      DIMENSION X(1), Y(1), W(1), F(1)
      DIMENSION WRK(1)
C
      REAL     F
      REAL     HOLD
      REAL     SQR
      REAL     TEMP
      REAL     TERM
      REAL     W
      REAL     WRK
      REAL     X
      REAL     Y
C
      NF = LF
      NF = MIN0 ( LONG, NF )
      NN = NF * NF
C
C     INDEXES OF WRK FOR RXX, RYY
C
      IRXX = NF + 1
      IRYY = IRXX + NF * NF
C
C     CASE WEIGHT FUNCTION VALUES ALL ZERO
C
      DO 100 L = 1, LONG
         IF (W(L) .GT. 0.) GO TO 140
 100  CONTINUE
      DO 120 N = 1, NF
         F(N) = 0.
 120  CONTINUE
      RETURN
C
C     CASE NON-ZERO WEIGHTING FUNCTION
C
 140  CONTINUE
      DO 160 N = 1, NN
         WRK(IRXX + N - 1) = 0.0
 160  CONTINUE
      DO 180 N = 1, LF
         F(N) = 0.
         WRK(N) = 0.0
 180  CONTINUE
      DO 240 L = 1, LONG
         HOLD = 1.
         TEMP = X(L)
         SQR = W(L) * W(L)
         IF (ICODE .NE. 0) SQR = SQR * SQR
         DO 220 M = 1, NF
            NN = (M - 1 )  * NF + IRXX - 1
            TERM = HOLD
            WRK(M) = WRK(M) + HOLD * Y(L) * SQR
            DO 200 N = 1, NF
               WRK(NN + N) = WRK(NN + N) + TERM * SQR
               TERM = TERM * TEMP
 200        CONTINUE
            HOLD = HOLD * TEMP
 220     CONTINUE
 240  CONTINUE
      NFNF = NF * NF
      CALL SASYMIV ( WRK(IRXX), NFNF, NF, WRK(IRYY), IERR )
      DO 280 M = 1, NF
         NN = (M - 1 )  * NF + IRYY - 1
         HOLD = 0.
         DO 260 N = 1, NF
            HOLD = HOLD + WRK(NN + N) * WRK(N)
 260     CONTINUE
         F(M) = HOLD
 280  CONTINUE
C
      RETURN
      END