share/minpack/fortran/lmder1.f

   1       subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info,ipvt,wa,
   2      *                  lwa)
   3       integer m,n,ldfjac,info,lwa
   4       integer ipvt(n)
   5       double precision tol
   6       double precision x(n),fvec(m),fjac(ldfjac,n),wa(lwa)
   7       external fcn
   8 c     **********
   9 c
  10 c     subroutine lmder1
  11 c
  12 c     the purpose of lmder1 is to minimize the sum of the squares of
  13 c     m nonlinear functions in n variables by a modification of the
  14 c     levenberg-marquardt algorithm. this is done by using the more
  15 c     general least-squares solver lmder. the user must provide a
  16 c     subroutine which calculates the functions and the jacobian.
  17 c
  18 c     the subroutine statement is
  19 c
  20 c       subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info,
  21 c                         ipvt,wa,lwa)
  22 c
  23 c     where
  24 c
  25 c       fcn is the name of the user-supplied subroutine which
  26 c         calculates the functions and the jacobian. fcn must
  27 c         be declared in an external statement in the user
  28 c         calling program, and should be written as follows.
  29 c
  30 c         subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag)
  31 c         integer m,n,ldfjac,iflag
  32 c         double precision x(n),fvec(m),fjac(ldfjac,n)
  33 c         ----------
  34 c         if iflag = 1 calculate the functions at x and
  35 c         return this vector in fvec. do not alter fjac.
  36 c         if iflag = 2 calculate the jacobian at x and
  37 c         return this matrix in fjac. do not alter fvec.
  38 c         ----------
  39 c         return
  40 c         end
  41 c
  42 c         the value of iflag should not be changed by fcn unless
  43 c         the user wants to terminate execution of lmder1.
  44 c         in this case set iflag to a negative integer.
  45 c
  46 c       m is a positive integer input variable set to the number
  47 c         of functions.
  48 c
  49 c       n is a positive integer input variable set to the number
  50 c         of variables. n must not exceed m.
  51 c
  52 c       x is an array of length n. on input x must contain
  53 c         an initial estimate of the solution vector. on output x
  54 c         contains the final estimate of the solution vector.
  55 c
  56 c       fvec is an output array of length m which contains
  57 c         the functions evaluated at the output x.
  58 c
  59 c       fjac is an output m by n array. the upper n by n submatrix
  60 c         of fjac contains an upper triangular matrix r with
  61 c         diagonal elements of nonincreasing magnitude such that
  62 c
  63 c                t     t           t
  64 c               p *(jac *jac)*p = r *r,
  65 c
  66 c         where p is a permutation matrix and jac is the final
  67 c         calculated jacobian. column j of p is column ipvt(j)
  68 c         (see below) of the identity matrix. the lower trapezoidal
  69 c         part of fjac contains information generated during
  70 c         the computation of r.
  71 c
  72 c       ldfjac is a positive integer input variable not less than m
  73 c         which specifies the leading dimension of the array fjac.
  74 c
  75 c       tol is a nonnegative input variable. termination occurs
  76 c         when the algorithm estimates either that the relative
  77 c         error in the sum of squares is at most tol or that
  78 c         the relative error between x and the solution is at
  79 c         most tol.
  80 c
  81 c       info is an integer output variable. if the user has
  82 c         terminated execution, info is set to the (negative)
  83 c         value of iflag. see description of fcn. otherwise,
  84 c         info is set as follows.
  85 c
  86 c         info = 0  improper input parameters.
  87 c
  88 c         info = 1  algorithm estimates that the relative error
  89 c                   in the sum of squares is at most tol.
  90 c
  91 c         info = 2  algorithm estimates that the relative error
  92 c                   between x and the solution is at most tol.
  93 c
  94 c         info = 3  conditions for info = 1 and info = 2 both hold.
  95 c
  96 c         info = 4  fvec is orthogonal to the columns of the
  97 c                   jacobian to machine precision.
  98 c
  99 c         info = 5  number of calls to fcn with iflag = 1 has
 100 c                   reached 100*(n+1).
 101 c
 102 c         info = 6  tol is too small. no further reduction in
 103 c                   the sum of squares is possible.
 104 c
 105 c         info = 7  tol is too small. no further improvement in
 106 c                   the approximate solution x is possible.
 107 c
 108 c       ipvt is an integer output array of length n. ipvt
 109 c         defines a permutation matrix p such that jac*p = q*r,
 110 c         where jac is the final calculated jacobian, q is
 111 c         orthogonal (not stored), and r is upper triangular
 112 c         with diagonal elements of nonincreasing magnitude.
 113 c         column j of p is column ipvt(j) of the identity matrix.
 114 c
 115 c       wa is a work array of length lwa.
 116 c
 117 c       lwa is a positive integer input variable not less than 5*n+m.
 118 c
 119 c     subprograms called
 120 c
 121 c       user-supplied ...... fcn
 122 c
 123 c       minpack-supplied ... lmder
 124 c
 125 c     argonne national laboratory. minpack project. march 1980.
 126 c     burton s. garbow, kenneth e. hillstrom, jorge j. more
 127 c
 128 c     **********
 129       integer maxfev,mode,nfev,njev,nprint
 130       double precision factor,ftol,gtol,xtol,zero
 131       data factor,zero /1.0d2,0.0d0/
 132       info = 0
 133 c
 134 c     check the input parameters for errors.
 135 c
 136       if (n .le. 0 .or. m .lt. n .or. ldfjac .lt. m .or. tol .lt. zero
 137      *    .or. lwa .lt. 5*n + m) go to 10
 138 c
 139 c     call lmder.
 140 c
 141       maxfev = 100*(n + 1)
 142       ftol = tol
 143       xtol = tol
 144       gtol = zero
 145       mode = 1
 146       nprint = 0
 147       call lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol,maxfev,
 148      *           wa(1),mode,factor,nprint,info,nfev,njev,ipvt,wa(n+1),
 149      *           wa(2*n+1),wa(3*n+1),wa(4*n+1),wa(5*n+1))
 150       if (info .eq. 8) info = 4
 151    10 continue
 152       return
 153 c
 154 c     last card of subroutine lmder1.
 155 c
 156       end