Sub FLmstr(M As Long, N As Long, X() As Double, Fvec() As Double, Fjrow() As Double, IFlag As Long)
Dim Xdata(3) As Double, Ydata(3) As Double, I As Long
Ydata(0) = 10.07: Xdata(0) = 77.6
Ydata(1) = 29.61: Xdata(1) = 239.9
Ydata(2) = 50.76: Xdata(2) = 434.8
Ydata(3) = 81.78: Xdata(3) = 760
If IFlag = 1 Then
For I = 0 To M - 1
Fvec(I) = Ydata(I) - X(0) * (1 - Exp(-Xdata(I) * X(1)))
Next
ElseIf IFlag >= 2 And IFlag <= M + 1 Then
Fjrow(0) = Exp(-Xdata(IFlag - 2) * X(1)) - 1
Fjrow(1) = -Xdata(IFlag - 2) * X(0) * Exp(-X(1) * Xdata(IFlag - 2))
End If
End Sub
Sub Ex_Lmstr1_r()
Const M = 4, N = 2
Dim X(N - 1) As Double, Fvec(M - 1) As Double, Fjac(M - 1, N - 1) As Double
Dim Tol As Double, Ipvt(N - 1) As Long, Info As Long
Dim XX(N - 1) As Double, YY(M - 1) As Double, YYpr(N - 1) As Double
Dim IRev As Long, IFlag As Long
Tol = 0.00000001 '1.0e-8
X(0) = 500: X(1) = 0.0001
IRev = 0
Do
Call
Lmstr1_r(M, N, X(), Fvec(), Fjac(), Tol, Ipvt(), Info, XX(), YY(), YYpr(), IRev)
If IRev = 1 Then
IFlag = 1
Call FLmstr(M, N, XX(), YY(), YYpr(), IFlag)
ElseIf IRev >= 10 Then
IFlag = IRev - 10 + 2
Call FLmstr(M, N, XX(), YY(), YYpr(), IFlag)
End If
Loop While IRev <> 0
Debug.Print "C1, C2 =", X(0), X(1)
Debug.Print "Info =", Info
End Sub
Sub Lmstr1_r(M As Long, N As Long, X() As Double, Fvec() As Double, Fjac() As Double, Tol As Double, Ipvt() As Long, Info As Long, XX() As Double, YY() As Double, YYpr() As Double, IRev As Long, Optional Info2 As Long)
Nonlinear least squares approximation by Levenberg-Marquardt method (limited storage) (simple driver)...