relibc_openlibm/slatec/snls1e.f

*DECK SNLS1E
      SUBROUTINE SNLS1E (FCN, IOPT, M, N, X, FVEC, TOL, NPRINT, INFO,
     +   IW, WA, LWA)
C***BEGIN PROLOGUE  SNLS1E
C***PURPOSE  An easy-to-use code which minimizes the sum of the squares
C            of M nonlinear functions in N variables by a modification
C            of the Levenberg-Marquardt algorithm.
C***LIBRARY   SLATEC
C***CATEGORY  K1B1A1, K1B1A2
C***TYPE      SINGLE PRECISION (SNLS1E-S, DNLS1E-D)
C***KEYWORDS  EASY-TO-USE, LEVENBERG-MARQUARDT, NONLINEAR DATA FITTING,
C             NONLINEAR LEAST SQUARES
C***AUTHOR  Hiebert, K. L., (SNLA)
C***DESCRIPTION
C
C 1. Purpose.
C
C       The purpose of SNLS1E is to minimize the sum of the squares of M
C       nonlinear functions in N variables by a modification of the
C       Levenberg-Marquardt algorithm.  This is done by using the more
C       general least-squares solver SNLS1.  The user must provide a
C       subroutine which calculates the functions.  The user has the
C       option of how the Jacobian will be supplied.  The user can
C       supply the full Jacobian, or the rows of the Jacobian (to avoid
C       storing the full Jacobian), or let the code approximate the
C       Jacobian by forward-differencing.  This code is the combination
C       of the MINPACK codes (Argonne) LMDER1, LMDIF1, and LMSTR1.
C
C
C 2. Subroutine and Type Statements.
C
C       SUBROUTINE SNLS1E(FCN,IOPT,M,N,X,FVEC,TOL,NPRINT,
C      *                  INFO,IW,WA,LWA)
C       INTEGER IOPT,M,N,NPRINT,INFO,LWA
C       INTEGER IW(N)
C       REAL TOL
C       REAL X(N),FVEC(M),WA(LWA)
C       EXTERNAL FCN
C
C
C 3. Parameters.
C
C       Parameters designated as input parameters must be specified on
C       entry to SNLS1E and are not changed on exit, while parameters
C       designated as output parameters need not be specified on entry
C       and are set to appropriate values on exit from SNLS1E.
C
C       FCN is the name of the user-supplied subroutine which calculates
C         the functions.  If the user wants to supply the Jacobian
C         (IOPT=2 or 3), then FCN must be written to calculate the
C         Jacobian, as well as the functions.  See the explanation
C         of the IOPT argument below.
C         If the user wants the iterates printed (NPRINT positive), then
C         FCN must do the printing.  See the explanation of NPRINT
C         below.  FCN must be declared in an EXTERNAL statement in the
C         calling program and should be written as follows.
C
C
C         SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
C         INTEGER IFLAG,LDFJAC,M,N
C         REAL X(N),FVEC(M)
C         ----------
C         FJAC and LDFJAC may be ignored     , if IOPT=1.
C         REAL FJAC(LDFJAC,N)                , if IOPT=2.
C         REAL FJAC(N)                       , if IOPT=3.
C         ----------
C           If IFLAG=0, the values in X and FVEC are available
C           for printing.  See the explanation of NPRINT below.
C           IFLAG will never be zero unless NPRINT is positive.
C           The values of X and FVEC must not be changed.
C         RETURN
C         ----------
C           If IFLAG=1, calculate the functions at X and return
C           this vector in FVEC.
C         RETURN
C         ----------
C           If IFLAG=2, calculate the full Jacobian at X and return
C           this matrix in FJAC.  Note that IFLAG will never be 2 unless
C           IOPT=2.  FVEC contains the function values at X and must
C           not be altered.  FJAC(I,J) must be set to the derivative
C           of FVEC(I) with respect to X(J).
C         RETURN
C         ----------
C           If IFLAG=3, calculate the LDFJAC-th row of the Jacobian
C           and return this vector in FJAC.  Note that IFLAG will
C           never be 3 unless IOPT=3.  FVEC contains the function
C           values at X and must not be altered.  FJAC(J) must be
C           set to the derivative of FVEC(LDFJAC) with respect to X(J).
C         RETURN
C         ----------
C         END
C
C
C         The value of IFLAG should not be changed by FCN unless the
C         user wants to terminate execution of SNLS1E.  In this case,
C         set IFLAG to a negative integer.
C
C
C       IOPT is an input variable which specifies how the Jacobian will
C         be calculated.  If IOPT=2 or 3, then the user must supply the
C         Jacobian, as well as the function values, through the
C         subroutine FCN.  If IOPT=2, the user supplies the full
C         Jacobian with one call to FCN.  If IOPT=3, the user supplies
C         one row of the Jacobian with each call.  (In this manner,
C         storage can be saved because the full Jacobian is not stored.)
C         If IOPT=1, the code will approximate the Jacobian by forward
C         differencing.
C
C       M is a positive integer input variable set to the number of
C         functions.
C
C       N is a positive integer input variable set to the number of
C         variables.  N must not exceed M.
C
C       X is an array of length N.  On input, X must contain an initial
C         estimate of the solution vector.  On output, X contains the
C         final estimate of the solution vector.
C
C       FVEC is an output array of length M which contains the functions
C         evaluated at the output X.
C
C       TOL is a non-negative input variable.  Termination occurs when
C         the algorithm estimates either that the relative error in the
C         sum of squares is at most TOL or that the relative error
C         between X and the solution is at most TOL.  Section 4 contains
C         more details about TOL.
C
C       NPRINT is an integer input variable that enables controlled
C         printing of iterates if it is positive.  In this case, FCN is
C         called with IFLAG = 0 at the beginning of the first iteration
C         and every NPRINT iterations thereafter and immediately prior
C         to return, with X and FVEC available for printing. Appropriate
C         print statements must be added to FCN (see example) and
C         FVEC should not be altered.  If NPRINT is not positive, no
C         special calls of FCN with IFLAG = 0 are made.
C
C       INFO is an integer output variable.  If the user has terminated
C         execution, INFO is set to the (negative) value of IFLAG.  See
C         description of FCN and JAC. Otherwise, INFO is set as follows.
C
C         INFO = 0  improper input parameters.
C
C         INFO = 1  algorithm estimates that the relative error in the
C                   sum of squares is at most TOL.
C
C         INFO = 2  algorithm estimates that the relative error between
C                   X and the solution is at most TOL.
C
C         INFO = 3  conditions for INFO = 1 and INFO = 2 both hold.
C
C         INFO = 4  FVEC is orthogonal to the columns of the Jacobian to
C                   machine precision.
C
C         INFO = 5  number of calls to FCN has reached 100*(N+1)
C                   for IOPT=2 or 3 or 200*(N+1) for IOPT=1.
C
C         INFO = 6  TOL is too small.  No further reduction in the sum
C                   of squares is possible.
C
C         INFO = 7  TOL is too small.  No further improvement in the
C                   approximate solution X is possible.
C
C         Sections 4 and 5 contain more details about INFO.
C
C       IW is an INTEGER work array of length N.
C
C       WA is a work array of length LWA.
C
C       LWA is a positive integer input variable not less than
C         N*(M+5)+M for IOPT=1 and 2 or N*(N+5)+M for IOPT=3.
C
C
C 4. Successful Completion.
C
C       The accuracy of SNLS1E is controlled by the convergence parame-
C       ter TOL.  This parameter is used in tests which make three types
C       of comparisons between the approximation X and a solution XSOL.
C       SNLS1E terminates when any of the tests is satisfied.  If TOL is
C       less than the machine precision (as defined by the function
C       R1MACH(4)), then SNLS1E only attempts to satisfy the test
C       defined by the machine precision.  Further progress is not usu-
C       ally possible.  Unless high precision solutions are required,
C       the recommended value for TOL is the square root of the machine
C       precision.
C
C       The tests assume that the functions are reasonably well behaved,
C       and, if the Jacobian is supplied by the user, that the functions
C       and the Jacobian are coded consistently.  If these conditions
C       are not satisfied, then SNLS1E may incorrectly indicate conver-
C       gence.  If the Jacobian is coded correctly or IOPT=1,
C       then the validity of the answer can be checked, for example, by
C       rerunning SNLS1E with tighter tolerances.
C
C       First Convergence Test.  If ENORM(Z) denotes the Euclidean norm
C         of a vector Z, then this test attempts to guarantee that
C
C               ENORM(FVEC) .LE. (1+TOL)*ENORM(FVECS),
C
C         where FVECS denotes the functions evaluated at XSOL.  If this
C         condition is satisfied with TOL = 10**(-K), then the final
C         residual norm ENORM(FVEC) has K significant decimal digits and
C         INFO is set to 1 (or to 3 if the second test is also satis-
C         fied).
C
C       Second Convergence Test.  If D is a diagonal matrix (implicitly
C         generated by SNLS1E) whose entries contain scale factors for
C         the variables, then this test attempts to guarantee that
C
C               ENORM(D*(X-XSOL)) .LE.  TOL*ENORM(D*XSOL).
C
C         If this condition is satisfied with TOL = 10**(-K), then the
C         larger components of D*X have K significant decimal digits and
C         INFO is set to 2 (or to 3 if the first test is also satis-
C         fied).  There is a danger that the smaller components of D*X
C         may have large relative errors, but the choice of D is such
C         that the accuracy of the components of X is usually related to
C         their sensitivity.
C
C       Third Convergence Test.  This test is satisfied when FVEC is
C         orthogonal to the columns of the Jacobian to machine preci-
C         sion.  There is no clear relationship between this test and
C         the accuracy of SNLS1E, and furthermore, the test is equally
C         well satisfied at other critical points, namely maximizers and
C         saddle points.  Therefore, termination caused by this test
C         (INFO = 4) should be examined carefully.
C
C
C 5. Unsuccessful Completion.
C
C       Unsuccessful termination of SNLS1E can be due to improper input
C       parameters, arithmetic interrupts, or an excessive number of
C       function evaluations.
C
C       Improper Input Parameters.  INFO is set to 0 if IOPT .LT. 1
C         or IOPT .GT. 3, or N .LE. 0, or M .LT. N, or TOL .LT. 0.E0,
C         or for IOPT=1 or 2 LWA .LT. N*(M+5)+M, or for IOPT=3
C         LWA .LT. N*(N+5)+M.
C
C       Arithmetic Interrupts.  If these interrupts occur in the FCN
C         subroutine during an early stage of the computation, they may
C         be caused by an unacceptable choice of X by SNLS1E.  In this
C         case, it may be possible to remedy the situation by not evalu-
C         ating the functions here, but instead setting the components
C         of FVEC to numbers that exceed those in the initial FVEC.
C
C       Excessive Number of Function Evaluations.  If the number of
C         calls to FCN reaches 100*(N+1) for IOPT=2 or 3 or 200*(N+1)
C         for IOPT=1, then this indicates that the routine is converging
C         very slowly as measured by the progress of FVEC, and INFO is
C         set to 5.  In this case, it may be helpful to restart SNLS1E,
C         thereby forcing it to disregard old (and possibly harmful)
C         information.
C
C
C 6. Characteristics of the Algorithm.
C
C       SNLS1E is a modification of the Levenberg-Marquardt algorithm.
C       Two of its main characteristics involve the proper use of
C       implicitly scaled variables and an optimal choice for the cor-
C       rection.  The use of implicitly scaled variables achieves scale
C       invariance of SNLS1E and limits the size of the correction in
C       any direction where the functions are changing rapidly.  The
C       optimal choice of the correction guarantees (under reasonable
C       conditions) global convergence from starting points far from the
C       solution and a fast rate of convergence for problems with small
C       residuals.
C
C       Timing.  The time required by SNLS1E to solve a given problem
C         depends on M and N, the behavior of the functions, the accu-
C         racy requested, and the starting point.  The number of arith-
C         metic operations needed by SNLS1E is about N**3 to process
C         each evaluation of the functions (call to FCN) and to process
C         each evaluation of the Jacobian SNLS1E takes M*N**2 for IOPT=2
C         (one call to JAC), M*N**2 for IOPT=1 (N calls to FCN) and
C         1.5*M*N**2 for IOPT=3 (M calls to FCN).  Unless FCN
C         can be evaluated quickly, the timing of SNLS1E will be
C         strongly influenced by the time spent in FCN.
C
C       Storage.  SNLS1E requires (M*N + 2*M + 6*N) for IOPT=1 or 2 and
C         (N**2 + 2*M + 6*N) for IOPT=3 single precision storage
C         locations and N integer storage locations, in addition to
C         the storage required by the program.  There are no internally
C         declared storage arrays.
C
C *Long Description:
C
C 7. Example.
C
C       The problem is to determine the values of X(1), X(2), and X(3)
C       which provide the best fit (in the least squares sense) of
C
C             X(1) + U(I)/(V(I)*X(2) + W(I)*X(3)),  I = 1, 15
C
C       to the data
C
C             Y = (0.14,0.18,0.22,0.25,0.29,0.32,0.35,0.39,
C                  0.37,0.58,0.73,0.96,1.34,2.10,4.39),
C
C       where U(I) = I, V(I) = 16 - I, and W(I) = MIN(U(I),V(I)).  The
C       I-th component of FVEC is thus defined by
C
C             Y(I) - (X(1) + U(I)/(V(I)*X(2) + W(I)*X(3))).
C
C       **********
C
C       PROGRAM TEST
C C
C C     Driver for SNLS1E example.
C C
C       INTEGER I,IOPT,M,N,NPRINT,JNFO,LWA,NWRITE
C       INTEGER IW(3)
C       REAL TOL,FNORM
C       REAL X(3),FVEC(15),WA(75)
C       REAL ENORM,R1MACH
C       EXTERNAL FCN
C       DATA NWRITE /6/
C C
C       IOPT = 1
C       M = 15
C       N = 3
C C
C C     The following starting values provide a rough fit.
C C
C       X(1) = 1.E0
C       X(2) = 1.E0
C       X(3) = 1.E0
C C
C       LWA = 75
C       NPRINT = 0
C C
C C     Set TOL to the square root of the machine precision.
C C     Unless high precision solutions are required,
C C     this is the recommended setting.
C C
C       TOL = SQRT(R1MACH(4))
C C
C       CALL SNLS1E(FCN,IOPT,M,N,X,FVEC,TOL,NPRINT,
C      *            INFO,IW,WA,LWA)
C       FNORM = ENORM(M,FVEC)
C       WRITE (NWRITE,1000) FNORM,INFO,(X(J),J=1,N)
C       STOP
C  1000 FORMAT (5X,' FINAL L2 NORM OF THE RESIDUALS',E15.7 //
C      *        5X,' EXIT PARAMETER',16X,I10 //
C      *        5X,' FINAL APPROXIMATE SOLUTION' // 5X,3E15.7)
C       END
C       SUBROUTINE FCN(IFLAG,M,N,X,FVEC,DUM,IDUM)
C C     This is the form of the FCN routine if IOPT=1,
C C     that is, if the user does not calculate the Jacobian.
C       INTEGER M,N,IFLAG
C       REAL X(N),FVEC(M)
C       INTEGER I
C       REAL TMP1,TMP2,TMP3,TMP4
C       REAL Y(15)
C       DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),
C      *     Y(9),Y(10),Y(11),Y(12),Y(13),Y(14),Y(15)
C      *     /1.4E-1,1.8E-1,2.2E-1,2.5E-1,2.9E-1,3.2E-1,3.5E-1,3.9E-1,
C      *      3.7E-1,5.8E-1,7.3E-1,9.6E-1,1.34E0,2.1E0,4.39E0/
C C
C       IF (IFLAG .NE. 0) GO TO 5
C C
C C     Insert print statements here when NPRINT is positive.
C C
C       RETURN
C     5 CONTINUE
C       DO 10 I = 1, M
C          TMP1 = I
C          TMP2 = 16 - I
C          TMP3 = TMP1
C          IF (I .GT. 8) TMP3 = TMP2
C          FVEC(I) = Y(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
C    10    CONTINUE
C       RETURN
C       END
C
C
C       Results obtained with different compilers or machines
C       may be slightly different.
C
C       FINAL L2 NORM OF THE RESIDUALS  0.9063596E-01
C
C       EXIT PARAMETER                         1
C
C       FINAL APPROXIMATE SOLUTION
C
C        0.8241058E-01  0.1133037E+01  0.2343695E+01
C
C
C       For IOPT=2, FCN would be modified as follows to also
C       calculate the full Jacobian when IFLAG=2.
C
C       SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
C C
C C     This is the form of the FCN routine if IOPT=2,
C C     that is, if the user calculates the full Jacobian.
C C
C       INTEGER LDFJAC,M,N,IFLAG
C       REAL X(N),FVEC(M)
C       REAL FJAC(LDFJAC,N)
C       INTEGER I
C       REAL TMP1,TMP2,TMP3,TMP4
C       REAL Y(15)
C       DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),
C      *     Y(9),Y(10),Y(11),Y(12),Y(13),Y(14),Y(15)
C      *     /1.4E-1,1.8E-1,2.2E-1,2.5E-1,2.9E-1,3.2E-1,3.5E-1,3.9E-1,
C      *      3.7E-1,5.8E-1,7.3E-1,9.6E-1,1.34E0,2.1E0,4.39E0/
C C
C       IF (IFLAG .NE. 0) GO TO 5
C C
C C     Insert print statements here when NPRINT is positive.
C C
C       RETURN
C     5 CONTINUE
C       IF(IFLAG.NE.1) GO TO 20
C       DO 10 I = 1, M
C          TMP1 = I
C          TMP2 = 16 - I
C          TMP3 = TMP1
C          IF (I .GT. 8) TMP3 = TMP2
C          FVEC(I) = Y(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
C    10    CONTINUE
C       RETURN
C C
C C     Below, calculate the full Jacobian.
C C
C    20    CONTINUE
C C
C       DO 30 I = 1, M
C          TMP1 = I
C          TMP2 = 16 - I
C          TMP3 = TMP1
C          IF (I .GT. 8) TMP3 = TMP2
C          TMP4 = (X(2)*TMP2 + X(3)*TMP3)**2
C          FJAC(I,1) = -1.E0
C          FJAC(I,2) = TMP1*TMP2/TMP4
C          FJAC(I,3) = TMP1*TMP3/TMP4
C    30    CONTINUE
C       RETURN
C       END
C
C
C       For IOPT = 3, FJAC would be dimensioned as FJAC(3,3),
C         LDFJAC would be set to 3, and FCN would be written as
C         follows to calculate a row of the Jacobian when IFLAG=3.
C
C       SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
C C     This is the form of the FCN routine if IOPT=3,
C C     that is, if the user calculates the Jacobian row by row.
C       INTEGER M,N,IFLAG
C       REAL X(N),FVEC(M)
C       REAL FJAC(N)
C       INTEGER I
C       REAL TMP1,TMP2,TMP3,TMP4
C       REAL Y(15)
C       DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),
C      *     Y(9),Y(10),Y(11),Y(12),Y(13),Y(14),Y(15)
C      *     /1.4E-1,1.8E-1,2.2E-1,2.5E-1,2.9E-1,3.2E-1,3.5E-1,3.9E-1,
C      *      3.7E-1,5.8E-1,7.3E-1,9.6E-1,1.34E0,2.1E0,4.39E0/
C C
C       IF (IFLAG .NE. 0) GO TO 5
C C
C C     Insert print statements here when NPRINT is positive.
C C
C       RETURN
C     5 CONTINUE
C       IF( IFLAG.NE.1) GO TO 20
C       DO 10 I = 1, M
C          TMP1 = I
C          TMP2 = 16 - I
C          TMP3 = TMP1
C          IF (I .GT. 8) TMP3 = TMP2
C          FVEC(I) = Y(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
C    10    CONTINUE
C       RETURN
C C
C C     Below, calculate the LDFJAC-th row of the Jacobian.
C C
C    20 CONTINUE
C
C       I = LDFJAC
C          TMP1 = I
C          TMP2 = 16 - I
C          TMP3 = TMP1
C          IF (I .GT. 8) TMP3 = TMP2
C          TMP4 = (X(2)*TMP2 + X(3)*TMP3)**2
C          FJAC(1) = -1.E0
C          FJAC(2) = TMP1*TMP2/TMP4
C          FJAC(3) = TMP1*TMP3/TMP4
C       RETURN
C       END
C
C***REFERENCES  Jorge J. More, The Levenberg-Marquardt algorithm:
C                 implementation and theory.  In Numerical Analysis
C                 Proceedings (Dundee, June 28 - July 1, 1977, G. A.
C                 Watson, Editor), Lecture Notes in Mathematics 630,
C                 Springer-Verlag, 1978.
C***ROUTINES CALLED  SNLS1, XERMSG
C***REVISION HISTORY  (YYMMDD)
C   800301  DATE WRITTEN
C   890206  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
C   920501  Reformatted the REFERENCES section.  (WRB)
C***END PROLOGUE  SNLS1E
      INTEGER M,N,NPRINT,INFO,LWA,IOPT
      INTEGER INDEX,IW(*)
      REAL TOL
      REAL X(*),FVEC(*),WA(*)
      EXTERNAL FCN
      INTEGER MAXFEV,MODE,NFEV,NJEV
      REAL FACTOR,FTOL,GTOL,XTOL,ZERO,EPSFCN
      SAVE FACTOR, ZERO
      DATA FACTOR,ZERO /1.0E2,0.0E0/
C***FIRST EXECUTABLE STATEMENT  SNLS1E
      INFO = 0
C
C     CHECK THE INPUT PARAMETERS FOR ERRORS.
C
      IF (IOPT .LT. 1 .OR. IOPT .GT. 3 .OR.
     1    N .LE. 0 .OR. M .LT. N .OR. TOL .LT. ZERO
     2    .OR. LWA .LT. N*(N+5) + M) GO TO 10
      IF (IOPT .LT. 3 .AND. LWA .LT. N*(M+5) + M) GO TO 10
C
C     CALL SNLS1.
C
      MAXFEV = 100*(N + 1)
      IF (IOPT .EQ. 1) MAXFEV = 2*MAXFEV
      FTOL = TOL
      XTOL = TOL
      GTOL = ZERO
      EPSFCN = ZERO
      MODE = 1
      INDEX = 5*N+M
      CALL SNLS1(FCN,IOPT,M,N,X,FVEC,WA(INDEX+1),M,FTOL,XTOL,GTOL,
     1           MAXFEV,EPSFCN,WA(1),MODE,FACTOR,NPRINT,INFO,NFEV,NJEV,
     2           IW,WA(N+1),WA(2*N+1),WA(3*N+1),WA(4*N+1),WA(5*N+1))
      IF (INFO .EQ. 8) INFO = 4
   10 CONTINUE
      IF (INFO .EQ. 0) CALL XERMSG ('SLATEC', 'SNLS1E',
     +   'INVALID INPUT PARAMETER.', 2, 1)
      RETURN
C
C     LAST CARD OF SUBROUTINE SNLS1E.
C
      END