PDA_DCOV

Calculates the covariance matrix for a nonlinear data fitting problem

Origin

SLATEC
        SUBROUTINE PDA_DCOV (FCN, IOPT, M, N, X, FVEC, R, LDR, INFO, WA1,
       +                     WA2, WA3, WA4, STATUS)
  ***BEGIN PROLOGUE  PDA_DCOV
  ***PURPOSE  Calculate the covariance matrix for a nonlinear data
              fitting problem.  It is intended to be used after a
              successful return from either PDA_DNLS1 or PDA_DNLS1E.
  ***LIBRARY   SLATEC
  ***CATEGORY  K1B1
  ***TYPE      DOUBLE PRECISION (SCOV-S, DCOV-D)
  ***KEYWORDS  COVARIANCE MATRIX, NONLINEAR DATA FITTING,
               NONLINEAR LEAST SQUARES
  ***AUTHOR  Hiebert, K. L., (SNLA)
  ***DESCRIPTION
  
    1. Purpose.
  
       PDA_DCOV calculates the covariance matrix for a nonlinear data
       fitting problem.  It is intended to be used after a successful
       return from either PDA_DNLS1 or PDA_DNLS1E. PDA_DCOV and
       PDA_DNLS1 (and PDA_DNLS1E) have compatible parameters.  The
       required external subroutine, FCN, is the same for all three
       codes, PDA_DCOV, PDA_DNLS1, and PDA_DNLS1E.
  
    2. Subroutine and Type Statements.
  
       SUBROUTINE PDA_DCOV(FCN,IOPT,M,N,X,FVEC,R,LDR,INFO,
                           WA1,WA2,WA3,WA4)
       INTEGER IOPT,M,N,LDR,INFO
       DOUBLE PRECISION X(N),FVEC(M),R(LDR,N),WA1(N),WA2(N),WA3(N),WA4(M)
       EXTERNAL FCN
  
    3. Parameters. All TYPE REAL parameters are DOUBLE PRECISION
  
        FCN is the name of the user-supplied subroutine which calculates
           the functions.  If the user wants to supply the Jacobian
           (IOPT=2 or 3), then FCN must be written to calculate the
           Jacobian, as well as the functions.  See the explanation
           of the IOPT argument below.
           If the user wants the iterates printed in PDA_DNLS1 or PDA_DNLS1E,
           then FCN must do the printing.  See the explanation of NPRINT
           in PDA_DNLS1 or PDA_DNLS1E.  FCN must be declared in an EXTERNAL
           statement in the calling program and should be written as
           follows.
  
           SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
           INTEGER IFLAG,LDFJAC,M,N
           DOUBLE PRECISION X(N),FVEC(M)
           ----------
           FJAC and LDFJAC may be ignored       , if IOPT=1.
           DOUBLE PRECISION FJAC(LDFJAC,N)      , if IOPT=2.
           DOUBLE PRECISION FJAC(N)             , if IOPT=3.
           ----------
             If IFLAG=0, the values in X and FVEC are available
             for printing in PDA_DNLS1 or PDA_DNLS1E.
             IFLAG will never be zero when FCN is called by PDA_DCOV.
             The values of X and FVEC must not be changed.
           RETURN
           ----------
             If IFLAG=1, calculate the functions at X and return
             this vector in FVEC.
           RETURN
           ----------
             If IFLAG=2, calculate the full Jacobian at X and return
             this matrix in FJAC.  Note that IFLAG will never be 2 unless
             IOPT=2.  FVEC contains the function values at X and must
             not be altered.  FJAC(I,J) must be set to the derivative
             of FVEC(I) with respect to X(J).
           RETURN
           ----------
             If IFLAG=3, calculate the LDFJAC-th row of the Jacobian
             and return this vector in FJAC.  Note that IFLAG will
             never be 3 unless IOPT=3.  FJAC(J) must be set to
             the derivative of FVEC(LDFJAC) with respect to X(J).
           RETURN
           ----------
           END
  
  
           The value of IFLAG should not be changed by FCN unless the
           user wants to terminate execution of PDA_DCOV.  In this case, set
           IFLAG to a negative integer.
  
  
         IOPT is an input variable which specifies how the Jacobian will
           be calculated.  If IOPT=2 or 3, then the user must supply the
           Jacobian, as well as the function values, through the
           subroutine FCN.  If IOPT=2, the user supplies the full
           Jacobian with one call to FCN.  If IOPT=3, the user supplies
           one row of the Jacobian with each call.  (In this manner,
           storage can be saved because the full Jacobian is not stored.)
           If IOPT=1, the code will approximate the Jacobian by forward
           differencing.
  
         M is a positive integer input variable set to the number of
           functions.
  
         N is a positive integer input variable set to the number of
           variables.  N must not exceed M.
  
         X is an array of length N.  On input X must contain the value
           at which the covariance matrix is to be evaluated.  This is
           usually the value for X returned from a successful run of
           PDA_DNLS1 (or PDA_DNLS1E).  The value of X will not be changed.
  
      FVEC is an output array of length M which contains the functions
           evaluated at X.
  
         R is an output array.  For IOPT=1 and 2, R is an M by N array.
           For IOPT=3, R is an N by N array.  On output, if INFO=1,
           the upper N by N submatrix of R contains the covariance
           matrix evaluated at X.
  
       LDR is a positive integer input variable which specifies
           the leading dimension of the array R.  For IOPT=1 and 2,
           LDR must not be less than M.  For IOPT=3, LDR must not
           be less than N.
  
      INFO is an integer output variable.  If the user has terminated
           execution, INFO is set to the (negative) value of IFLAG.  See
           description of FCN. Otherwise, INFO is set as follows.
  
           INFO = 0 Improper input parameters (M.LE.0 or N.LE.0).
  
           INFO = 1 Successful return.  The covariance matrix has been
                    calculated and stored in the upper N by N
                    submatrix of R.
  
           INFO = 2 The Jacobian matrix is singular for the input value
                    of X.  The covariance matrix cannot be calculated.
                    The upper N by N submatrix of R contains the QR
                    factorization of the Jacobian (probably not of
                    interest to the user).
  
        WA1,WA2 are work arrays of length N.
                and WA3
  
       WA4 is a work array of length M.
  
  
         STATUS is an INTEGER error status. Set to zero on entry.
                If an error has occurred and has been reported then
                this will be non-zero on exit.
  
  ***REFERENCES  (NONE)
  ***ROUTINES CALLED  DENORM, DFDJC3, DQRFAC, DWUPDT, XERMSG
  ***REVISION HISTORY  (YYMMDD)
     810522  DATE WRITTEN
     890831  Modified array declarations.  (WRB)
     891006  Cosmetic changes to prologue.  (WRB)
     891006  REVISION DATE from Version 3.2
     891214  Prologue converted to Version 4.0 format.  (BAB)
     900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
     900510  Fixed an error message.  (RWC)
     970224  Now called PDA_DCOV. (PWD)
  ***END PROLOGUE  DCOV