Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64) | :: | IndepVar(10) | ||||
real(kind=r64) | :: | DepVar(10) | ||||
integer | :: | N | ||||
integer | :: | N1 | ||||
integer | :: | N2 | ||||
real(kind=r64) | :: | CoeffsCurve(6) |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE W5LsqFit(IndepVar,DepVar,N,N1,N2,CoeffsCurve)
! SUBROUTINE INFORMATION:
! AUTHOR George Walton
! DATE WRITTEN April 1976
! MODIFIED November 1999 F.Winkelmann
! 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(10) ! Independent variables
REAL(r64) :: DepVar(10) ! 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
! FLOW
! 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 W5LsqFit