Attribute VB_Name = "Module2" '********************************************************************* '* THIS PROGRAM TESTS CODES FOR THE LEAST-SQUARES SOLUTION OF * '* M NONLINEAR EQUATIONS IN N VARIABLES. IT CONSISTS OF A DRIVER * '* AND AN INTERFACE SUBROUTINE FCN. THE DRIVER READS IN DATA, * '* CALLS THE NONLINEAR LEAST-SQUARES SOLVER, AND FINALLY PRINTS * '* OUT INFORMATION ON THE PERFORMANCE OF THE SOLVER. THIS IS * '* ONLY A SAMPLE DRIVER, MANY OTHER DRIVERS ARE POSSIBLE. THE * '* INTERFACE SUBROUTINE FCN IS NECESSARY TO TAKE INTO ACCOUNT THE * '* FORMS OF CALLING SEQUENCES USED BY THE FUNCTION AND JACOBIAN * '* SUBROUTINES IN THE VARIOUS NONLINEAR LEAST-SQUARES SOLVERS. * '* * '* PROCEDURES OR FUNCTIONS CALLED (SEE UNIT LM.PAS): * '* * '* INITPT, SSQFCN, LMDIF1, ENORM, FCN * '* * '* From F77 program By: * '* ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980. * '* BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE * '* ----------------------------------------------------------------- * '* SAMPLE RUNS: * '* Example #1 (size 2) * '* Solve following system (with initial conditions x1=1, x2=1): * '* X1^2 + X1 + X2^2 - 2 = 0 * '* X1^2 + X2 - X2^2 - 1 + log(X1) = 0 * '* * '* Input #example(1 to 3), size N, Number of tries: 1 2 1 * '* PROBLEM 1 DIMENSIONS 2 2 * '* INITIAL L2 NORM OF THE RESIDUALS: 1 * '* FINAL L2 NORM OF THE RESIDUALS..: 2.69111559506109E-17 * '* NUMBER OF FUNCTION EVALUATION...: 25 * '* NUMBER OF JACOBIAN EVALUATIONS..: 6 * '* EXIT PARAMETER..................: 2 * '* FINAL APPROXIMATE SOLUTION: * '* 0.915554 0.496191 * '* * '* SUMMARY OF 1 CALL(S) TO LMDIF1: * '* NPROB N M NFEV NJEV INFO FINAL L2 NORM * '* 1 2 2 25 6 2 2.69111559506109E-17 * '* * '* Example #2 (size 4) * '* Solve following system (with initial conditions x1..x4 = 1): * '* 10.0*x + x2 + x3 + x4 - 20.0 + Sqr(sin(x1)) + Sqr(cos(x2)) = 0 * '* x1 + 20.0*x2 + x3 + x4 - 48.0 + one/pow^6 = 0 * '* Sqr(x1 + x2) + 30.0*x3 + x4 - 97.0 + log(x1) + log(x2+x3) = 0 * '* x1 + x2 + x3 + 40.0*x4 - 166.0 + Sqr(x1) = 0 * '* * '* Input #example(1 to 3), size N, Number of tries: 2 4 1 * '* PROBLEM 2 DIMENSIONS 4 4 * '* INITIAL L2 NORM OF THE RESIDUALS: 138.760694011757 * '* FINAL L2 NORM OF THE RESIDUALS..: 2.51896394857635E-15 * '* NUMBER OF FUNCTION EVALUATION...: 31 * '* NUMBER OF JACOBIAN EVALUATIONS..: 5 * '* EXIT PARAMETER..................: 2 * '* FINAL APPROXIMATE SOLUTION......: * '* 1.040647 1.972398 2.745049 3.978973 * '* * '* SUMMARY OF 1 CALL(S) TO LMDIF1: * '* NPROB N M NFEV NJEV INFO FINAL L2 NORM * '* 2 4 4 31 5 2 2.51896394857635E-15 * '* * '* Example #3 (size 6) - Stiff system * '* Solve following system (with initial conditions x1..x6 = 1): * '* X1 + X2 + X4 - .001 = 0 * '* X5 + X6 -55 = 0 * '* X1 + X2 + X3 + 2X5 + X6 - 110.001 = 0 * '* X1 - 0.1X2 = 0 * '* X1 - 10000 X3 X4 = 0 * '* X5 - 5.5e15 X3 X6 = 0 * '* * '* Input #example(1 to 3), size N, Number of tries: 3 6 1 * '* PROBLEM 3 DIMENSIONS 6 6 * '* INITIAL L2 NORM OF THE RESIDUALS: 5.5E+15 * '* FINAL L2 NORM OF THE RESIDUALS..: 2.67666427054371E-15 * '* NUMBER OF FUNCTION EVALUATION...: 161 * '* NUMBER OF JACOBIAN EVALUATIONS..: 20 * '* EXIT PARAMETER..................: 2 * '* FINAL APPROXIMATE SOLUTION......: * '* 0.000082 0.000826 0.00009 0.00009 54.999999 0 * '* * '* SUMMARY OF 1 CALL(S) TO LMDIF1: * '* NPROB N M NFEV NJEV INFO FINAL L2 NORM * '* 3 6 6 161 20 2 2.67666427054371E-15 * '* * '* Visual Basic 4.0 Release By J-P Moreau, Paris. * '* (www.jpmoreau.fr) * '********************************************************************* 'PROGRAM test_lmdif; DefDbl A-H, O-Z DefInt I-N Dim iwa(ISIZE), ma(ISIZE), na(ISIZE), nf(ISIZE), nj(ISIZE), np(ISIZE), nx(ISIZE) Dim fnm(ISIZE), fvec(ISIZE), x(ISIZE) Sub initpt(n, x(), nprob, factor) ' ************************************************************** ' Procedure INITPT ' THIS Procedure SPECIFIES THE STANDARD STARTING POINTS FOR THE ' FUNCTIONS DEFINED BY Procedure SSQFCN. THE Procedure RETURNS ' IN X A MULTIPLE (FACTOR) OF THE STANDARD STARTING POINT. FOR ' THE 11TH FUNCTION THE STANDARD STARTING POINT IS ZERO, SO IN ' THIS CASE, IF FACTOR IS NOT UNITY, THEN THE Procedure RETURNS ' THE VECTOR X(J) = FACTOR, J=1,...,N. ' THE Procedure STATEMENT IS ' PROCEDURE INITPT(N,X,NPROB,FACTOR) ' WHERE ' N IS A POSITIVE INTEGER INPUT VARIABLE. ' X IS AN OUTPUT ARRAY OF LENGTH N WHICH CONTAINS THE STANDARD ' STARTING POINT FOR PROBLEM NPROB MULTIPLIED BY FACTOR. ' NPROB IS A POSITIVE INTEGER INPUT VARIABLE WHICH DEFINES THE ' NUMBER OF THE PROBLEM. NPROB MUST NOT EXCEED 18. ' FACTOR IS AN INPUT VARIABLE WHICH SPECIFIES THE MULTIPLE OF ' THE STANDARD STARTING POINT. IF FACTOR IS UNITY, NO ' MULTIPLICATION IS PERFORMED. ' ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. MARCH 1980. ' BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE ' **************************************************************** ' SELECTION OF INITIAL POINT For j = 1 To n x(j) = one Next j ' COMPUTE MULTIPLE OF INITIAL POINT If factor = one Then Exit Sub For j = 1 To n x(j) = factor * x(j) Next j End Sub Sub Exec_Lmdif() 'main subroutine tol = 0.00000001 ic = 0 Form1.Print ' Quick Basic ' Input " Input #example (1 to 3): ", nprob nprob = InputBox("Input # example (1 to 3):", "Data", "1") If nprob = 1 Then n = 2 ElseIf nprob = 2 Then n = 4 ElseIf nprob = 3 Then n = 6 Else ' Quick Basic ' Print " Warning: Example not implemented!" Res = MsgBox("Example not implemented", vbOKCancel, "Warning") Exit Sub End If m = n ntries = 1 factor = one For k = 1 To ntries ic = ic + 1 initpt n, x, nprob, factor ssqfcn m, n, x, fvec, nprob fnorm1 = enorm(m, fvec) Form1.Print " PROBLEM "; nprob; " DIMENSIONS "; n; " "; m nfev = 0 njev = 0 lmdif1 m, n, x, fvec, tol, info, iwa ssqfcn m, n, x, fvec, nprob fnorm2 = enorm(m, fvec) np(ic) = nprob na(ic) = n ma(ic) = m nf(ic) = nfev njev = njev / n nj(ic) = njev nx(ic) = info fnm(ic) = fnorm2 Form1.Print " INITIAL L2 NORM OF THE RESIDUALS: "; fnorm1 Form1.Print " FINAL L2 NORM OF THE RESIDUALS..: "; fnorm2 Form1.Print " NUMBER OF FUNCTION EVALUATION...: "; nfev Form1.Print " NUMBER OF JACOBIAN EVALUATIONS..: "; njev Form1.Print " EXIT PARAMETER..................: "; info Form1.Print " FINAL APPROXIMATE SOLUTION: " For i = 1 To n Form1.Print " "; Int(x(i) * 1000000) / 1000000; Next i Form1.Print factor = ten * factor Next k Form1.Print Form1.Print " SUMMARY OF "; ic; " CALL(S) TO LMDIF1:" Form1.Print " NPROB N M NFEV NJEV INFO FINAL L2 NORM" For i = 1 To ic Form1.Print " "; np(i); " "; na(i); " "; ma(i); " "; nf(i); " "; nj(i); _ " "; nx(i); " "; fnm(i) Next i End Sub