W5LsqFit2 Subroutine

private subroutine W5LsqFit2(IndepVar, DepVar, N, N1, N2, CoeffsCurve)

Arguments

Type		Name
real(kind=r64)	::	IndepVar(19)
real(kind=r64)	::	DepVar(19)
integer	::	N
integer	::	N1
integer	::	N2
real(kind=r64)	::	CoeffsCurve(6)
Source Code

W5LsqFit2
Source Code

SUBROUTINE W5LsqFit2 (IndepVar,DepVar,N,N1,N2,CoeffsCurve)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         George Walton
          !       DATE WRITTEN   April 1976
          !       MODIFIED       November 1999 F.Winkelmann
          !                      May 2001 F. Winkelmann, to do 19 indep. variables
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! Does least squares fit for coefficients of a polynomial
          ! that gives a window property, such as transmittance, as a function of
          ! the cosine of the angle of incidence. The polynomial is of the
          ! form C1*X + C2*X**2 + C3*X**3 + ... +CN*X**N, where N <= 6.
          ! Adapted from BLAST subroutine LSQFIT.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

   IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64)              :: IndepVar(19)               ! Independent variables
REAL(r64)              :: DepVar(19)                 ! Dependent variables
INTEGER                :: N                          ! Order of polynomial
INTEGER                :: N1,N2                      ! First and last data points used
REAL(r64)              :: CoeffsCurve(6)             ! Polynomial coeffients from fit

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na

          ! DERIVED TYPE DEFINITIONS:
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: A(6,6)                     ! Least squares derivative matrix
REAL(r64) :: B(6)                       ! Least squares derivative vector
REAL(r64) :: D(16,6)                    ! Powers of independent variable
REAL(r64) :: ACON, SUM                  ! Intermediate variables
INTEGER          :: I, J, K, L, M, KP1, LP1, NM1 ! Loop parameters


! Set up least squares matrix
      DO M = N1,N2
        D(M,1) = IndepVar(M)
      END DO

      DO I = 2,N
        DO M = N1,N2
          D(M,I) = D(M,I-1)*IndepVar(M)
        END DO
      END DO

      DO I = 1,N
        SUM = 0.0d0
        DO M = N1,N2
          SUM = SUM+DepVar(M)*D(M,I)
        END DO
        B(I) = SUM
        DO J = 1,N
          SUM = 0.0d0
          DO M = N1,N2
            SUM = SUM+D(M,I)*D(M,J)
          END DO
          A(I,J) = SUM
          A(J,I) = SUM
        END DO
      END DO

! Solve the simultaneous equations using Gauss elimination
      NM1 = N-1
      DO K = 1,NM1
        KP1 = K+1
        DO I = KP1,N
          ACON = A(I,K)/A(K,K)
          B(I) = B(I)-B(K)*ACON
          DO J = K,N
            A(I,J) = A(I,J)-A(K,J)*ACON
          END DO
        END DO
      END DO

! Perform back substituion
      CoeffsCurve(N) = B(N)/A(N,N)
      LP1 = N
      L = N-1

      DO WHILE (L>0)
        SUM = 0.0d0
        DO J = LP1,N
          SUM = SUM+A(L,J)*CoeffsCurve(J)
        END DO
        CoeffsCurve(L) = (B(L)-SUM)/A(L,L)
        LP1 = L
        L = L-1
      END DO

RETURN
END SUBROUTINE W5LsqFit2
All Procedures
