C      ALGORITHM 676, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 15, NO. 4, PP. 348-364.
 Installation Manual for
 ODRPACK 1.71 -- Software for Weighted Orthogonal Distance Regression
 
 
 Direct questions to
 
      Janet R. Donaldson
      Optimization Group/Applied and Computational Mathematics Division (719)
      National Institute of Standards and Technology
      325 Broadway
      Boulder, CO 80303-3328
      (303) 497-5114
      e-mail:  internet -- jrd@alpha.bldr.nist.gov
               bitnet   -- jrd@nbs
 
 
 *** PHYSICAL CHARACTERISTICS OF TAPE
 
      A.  ASCII character set.
      B.  1600 cpi density.
      C.  Unlabeled.
      D.  17 files each repeated 3 times for a total of 51 files,
          each terminated by tapemarks.
      E.  Additional tapemark follows tapemark of last file.
      F.  Files consist of 1 or more blocks (physical records).
      G.  Files 1 to 16, 18 to 33, and 35 to 50 have blocks made up of 45
          line images (logical records) of 80 characters each.
      H.  Files 17, 34, and 51 have blocks made up of 20
          line images (logical records) of 132 characters each.
      I.  Last block of a file may contain fewer than 20 line images, in which
          case it is short, not blank filled.
 
 
 *** TAPE CONTENTS
 
 File No.  File Id.       Description
 --------  -----------    -----------
 
        1  TOC.DOC      - tape characteristics, file structure and
                          table of contents
                          (line image length = 80, block size = 3600)
 
        2  INSTALL.DOC  - the installation manual
                          (line image length = 80, block size = 3600)
        3  GUIDE.DOC    - ODRPACK user's reference guide,
                          in line printer format
                          (line image length = 80, block size = 3600)
 
 
        4  SODR.FOR     - single precision ODRPACK source code, excluding
                          LINPACK, BLAS and machine dependent subprograms
                          (line image length = 80, block size = 3600)
        5  SODRLPK.FOR  - single precision subprograms from LINPACK and BLAS
                          (line image length = 80, block size = 3600)
        6  SMPREC.FOR   - single precision machine dependent subprogram
                          (line image length = 80, block size = 3600)
 
 
        7  DODR.FOR     - double precision ODRPACK source code, excluding
                          LINPACK, BLAS and machine dependent subprograms
                          (line image length = 80, block size = 3600)
        8  DODRLPK.FOR  - double precision subprograms from LINPACK and BLAS
                          (line image length = 80, block size = 3600)
        9  DMPREC.FOR   - double precision machine dependent subprogram
                          (line image length = 80, block size = 3600)
 
 
       10  SDRIVE1.FOR  - sample driver for single precision user-callable
                          subprogram SODR
                          (line image length = 80, block size = 3600)
       11  SDRIVE2.FOR  - sample driver for single precision user-callable
                          subprogram SODRC
                          (line image length = 80, block size = 3600)
       12  DDRIVE1.FOR  - sample driver for double precision user-callable
                          subprogram DODR
                          (line image length = 80, block size = 3600)
       13  DDRIVE2.FOR  - sample driver for double precision user-callable
                          subprogram DODRC
                          (line image length = 80, block size = 3600)
 
       14  DATA1.DAT    - data set for sample drivers in files SDRIVE1.FOR,
                          SDRIVE2.FOR, DDRIVE1.FOR, and DDRIVE2.FOR.
                          (line image length = 80, block size = 3600)
 
 
       15  STEST.FOR    - driver for exercising single precision version
                          of ODRPACK
                          (line image length = 80, block size = 3600)
       16  DTEST.FOR    - driver for exercising double precision version
                          of ODRPACK
                          (line image length = 80, block size = 3600)
 
       17  TEST.TXT     - results obtained by the authors exercising the
                          double precision version of ODRPACK on a Sun 3
                          Workstation (64 bits per double precision value)
                          (line image length = 132, block size = 2640)
 
 
 18 to 34               - repeat of files 1 to 17
 
 
 35 to 51               - repeat of files 1 to 17
 
 
 
 *** INTRODUCTION
 
 ODRPACK is a portable collection of Fortran subprograms for fitting a model to
 data.  It is designed primarily for instances when the independent as well as
 the dependent variables have significant errors, implementing a highly
 efficient algorithm for solving the weighted orthogonal distance regression
 problem, i.e., for minimizing the sum of the squares of the weighted
 orthogonal distances between each data point and the curve described by the
 model equation.  It can also be used to solve the ordinary least squares
 problem where all of the errors are attributed to the observations of the
 dependent variable.
 
 ODRPACK is written in Fortran as defined in the 1978 standard (ANSI
 X3.9-1978), commonly called Fortran 77.  The code has been analyzed using the
 PFORT 77 verifyer in TOOLPACK, and based on this analysis we believe that
 ODRPACK is compatible with the ANSI X3.9-1978 full language standard.
 
 
 *** INSTALLING ODRPACK
 
 Step 1.  Select Single or Double Precision Version
 
 ODRPACK software is available in both single and double precision versions.
 Both versions are complete as they stand, and except for precision are
 identical.  They can be combined in a single library, if desired.  (Subprogram
 JAC, which is included in both source files SODR.FOR and DODR.FOR, is a dummy
 routine that is provided to prevent the occurrence of an unsatisfied external
 when finite difference derivatives are used.  Either version can be used in
 a combined library.)
 
 ODRPACK is sensitive to the machine precision, however, and requires
 approximately 14 decimal places.  Somewhat fewer places should still work, but
 six or seven decimal places are definitely too few for general use, since only
 the simplest problems could be solved correctly at such reduced precisions.
 The installer must therefore choose which version of ODRPACK to use based upon
 which version supplies adequate precision on the target machine.  To our
 knowledge, at present only Cray and CDC machines offer sufficient precision to
 permit general use of the single precision version of ODRPACK.  For other
 machines, we recommend the double precision version.
 
 If both versions of ODRPACK have sufficient precision on the installer's
 machine, then both may be used.  When both the single and double precision
 versions are available, however, there are trade offs between them.  The
 double precision version will offer greater accuracy in results, while the
 single precision will require less storage and possibly less machine time.
 
 
 Step 2:  Select ODRPACK Code Necessary for Installation on the Target System
 
 The code for each version of ODRPACK is separated into three sections to
 facilitate installation.  These three sections are in files SODR.FOR,
 SODRLPK.FOR and SMPREC.FOR for the single precision version, and in files
 DODR.FOR, DODRLPK.FOR and DMPREC.FOR for the double precision version.
 
 Files SODR.FOR and DODR.FOR include all subprograms written especially for
 ODRPACK.  The two user callable ODRPACK subprograms of each version are listed
 first, followed by the remaining subprograms listed in alphabetical order.
 The code in these files should not require any modification unless the
 installer wishes to customize the user callable subprograms.
 
 Files SODRLPK.FOR and DODRLPK.FOR include the subprograms used by ODRPACK from
 the public domain packages LINPACK and BLAS, also listed in alphabetical
 order.  The installer can use local versions of these packages if available.
 This would be particularly beneficial if the installer's machine has specially
 optimized versions of LINPACK or BLAS.
 
 Files SMPREC.FOR and DMPREC.FOR include the only machine dependent subprograms
 in ODRPACK.  Changes required to these files are described in Step 3, below.
 
 Each ODRPACK subprogram follows the SLATEC Source File Format and provides a
 standardized prologue describing the purpose of the subprogram and what other
 subprograms are called, an alphabetical list of all variables referenced by
 the subprogram and how they are used, as well as comments explaining the major
 sections of the code.  Furthermore, each ODRPACK subprogram begins with a
 comment line consisting of an asterisk followed immediately by the subprogram
 name, i.e., *name.  This is the only use of an asterisk in column 1 of the
 ODRPACK source code, and is done to aid the installer in separating the
 subprograms into individual files.
 
 
 Step 3.  Set Necessary Machine Dependent Values
 
 Files SMPREC.FOR and DMPREC.FOR supply the machine dependent constants used by
 ODRPACK.  Comment statements within these files document the modifications
 required.  They also list the necessary constants for a number of common
 machines.  If the constants for the target machine are included, then the
 installer need only "uncomment" the appropriate DATA statements.  These
 subprograms will return an undefined value until they are updated; the
 installer must update them before compiling and running ODRPACK.
 
 
 Step 4.  Compile ODRPACK Code and Generate Object Code Library
 
 ODRPACK code conforms to the ANSI X3.9-1978 full Fortran standard and has been
 successfully installed on a CDC Cyber 855, CDC Cyber 205, Concurrent 3230, DEC
 VAX 11/780, IBM PC/AT, and a Sun 3 Workstation.  We believe it is possible to
 install ODRPACK on any system with an ANSI Fortran 77 compiler and adequate
 memory.  The authors have detected compiler bugs, however, that affect ODRPACK
 when using FTN200 Cycle 661B on the Cyber 205 and when using Profort 1.0 and
 1.19 on the IBM PC/AT.
 
 In compiling ODRPACK, we recommend that the following compiler options be used
 if available.
 
    1.  Rounded arithmetic.
 
    2.  The most extensive set of error messages possible.  (In our experience
        it is well worth hearing everything that a compiler has to say about
        imported code.)
 
 Let us emphasize that we do not expect any problems with compilation.
 
 After the ODRPACK code has been successfully compiled, a Fortran object code
 library must be created.  The term object code library here refers to whatever
 facility the target system has for satisfying external references
 automatically at load time, using a collection of previously compiled
 subprograms.
 
 
 Step 5.  Test ODRPACK
 
 The ODRPACK supplied software includes drivers and data sets for running
 ODRPACK in both single and double precision.  There are three drivers for each
 version of the code.
 
 Files SDRIVE1.FOR, SDRIVE2.FOR, DDRIVE1.FOR and DDRIVE2.FOR contain simple
 programs that users can modify to form their own ODRPACK drivers.  The data
 necessary to run these drivers are in file DATA1.DAT; the reports generated by
 these drivers are shown in the Reference Guide (file GUIDE.DOC), Section VII.
 (The name of the data file specified in the 'OPEN' statement in these two
 drivers is 'DATA1'.  The data file name and/or the file name specified in the
 'OPEN' statement might have to be changed in order for the drivers to run
 properly on the target machine.)
 
 Files STEST.FOR and DTEST.FOR contain drivers that exercise ODRPACK's main
 features and can be used to verify that the installation was completed
 successfully.  The ODRPACK output generated by DTEST.FOR when run on a Sun 3
 Workstation using the double precision version of ODRPACK is listed in file
 TEST.TXT.  No data files are required for these two drivers.
 
 The drivers within files STEST.FOR and DTEST.FOR call subprograms SODRX and
 DODRX, respectively, as documented by the comment statements within each of
 the drivers.  These two subprograms each call the ODRPACK user callable
 subprograms several times, with each call testing one or more features of the
 package.  The results of each call are automatically compared to the results
 obtained by the authors using the double precision version of ODRPACK run on a
 CDC Cyber 205 under VSOS 2.3.7 PSR level 712 (124 bits per double precision
 value).  The success or failure of each test is noted individually in the
 output and is summarized for all of the data sets.
 
 The ODRPACK reports generated by these two drivers and a summary of the
 comparisons are written to files REPORT and SUMMARY, respectively.  By running
 these demonstration programs and then comparing file REPORT with TEST.TXT, the
 installer can easily ascertain whether the package is performing as it
 should.
 
 If the REPORT and SUMMARY files indicate that the results generated by the
 target machine disagree with the expected results, the installer should
 attempt to determine why.  The 3 most common causes of disagreement between
 the computed results and the expected results are:
 
    1.  incorrectly specified machine dependent constants (see Step 3 above);
 
    2.  use of the single precision version of ODRPACK on a target machine that
        requires double precision accuracy (see Step 1 above); and
 
    3.  compiler 'bugs'.
 
 We suggest that these potential problem areas be investigated before accepting
 a questionable installation as adequate.  If you are unable to find the cause
 of the reported disagreement, please feel free to contact the developers at
 the address given above.
 
 
 Step 6.  Distribute ODRPACK documentation
 
 The ODRPACK Reference Guide is supplied in line printer format in file
 GUIDE.DOC.  It is the installer's responsibility to make this documentation
 and future modifications to it available to local users.
 
 The on line documentation uses the standard Fortran conventions for printing
 formatted records.  In particular, the first character of each line is used to
 determine vertical spacing.  For correct printing, if the first character of a
 line is a blank then the printer should vertical space one line, and if the
 first character is a 1 then the printer should advance to the beginning of a
 new page.  The maximum page width is 80 columns (printer control included).
 The installer may modify the on line documentation as necessary if its format
 is not convenient.

1                                User's Reference Guide

                                          for

                                        ODRPACK
                 Software for Weighted Orthogonal Distance Regression

                                     Version  1.71
                                       07-27-89

                    National Institute of Standards and Technology
                       (formerly National Bureau of Standards)
                               Internal Report 89-4103





                                     Paul T. Boggs
                    Applied and Computational Mathematics Division
                    National Institute of Standards and Technology
                                Gaithersburg, MD 20899

                                    Richard H. Byrd
                            Department of Computer Science
                                University of Colorado
                                  Boulder, CO 80309

                                  Janet R. Donaldson
                    Applied and Computational Mathematics Division
                    National Institute of Standards and Technology
                                Boulder, CO 80303-3328

                                  Robert B. Schnabel
                            Department of Computer Science
                                University of Colorado
                                  Boulder, CO 80309
                                          and
                    Applied and Computational Mathematics Division
                    National Institute of Standards and Technology
                                Boulder, CO 80303-3328


                                    ***keywords***
                            orthogonal distance regression
                               measurement error models
                               nonlinear least squares
                                 errors in variables

                                   ***categories***
                                       G2E,I1B1




1                              *** REVISION HISTORY ***


    Revision            Description
    --------            -----------

    1.71 (07-27-89)     ODRPACK 1.71 corrects an error in the code that
                        performs the computation of finite difference
                        derivatives when M>=2 and the default value of IFIXX
                        is invoked.  (The default value of IFIXX is invoked
                        when IFIXX(1,1) is set to a negative value or when
                        ODRPACK routines DODR or SODR are called.)  This
                        error could result in incorrect ``fixing'' of the
                        independent variables, which would affect the final
                        solution.  Such ``fixing'' could be detected by
                        observing the presence of values of DELTA that were
                        identically zero.  The error could go undetected by
                        the user, however, if the values of DELTA were not
                        examined after the fit.




1   TABLE OF CONTENTS


       I.  Introduction

      II.  Background

     III.  Multiple Response Data

      IV.  Starting Values for BETA and DELTA

       V.  Default Values and Structured Arguments

      VI.  Subroutine Declaration and Call Statements

     VII.  Subroutine Argument Descriptions
           A.  Synopsis
           B.  Detailed Descriptions of
               ODRPACK User Callable Subroutine Arguments

    VIII.  Examples
           A.  DODR Example Program, Data and ODRPACK Generated Report
           B.  DODRC Example Program, Data and ODRPACK Generated Report

      IX.  Scaling Algorithms
           A.  Beta Scaling
           B.  Delta Scaling

       X.  Extracting Information from the Work Vectors
           A.  Extracting Information from Vector WORK
           B.  Extracting Information from Vector IWORK

      XI.  Acknowledgments

     XII.  References



1   I.  INTRODUCTION
        -------------

    ODRPACK is a portable collection of ANSI 77 Fortran subroutines for fitting
    a model to data.  It is designed primarily for instances when the
    independent as well as the dependent variables have significant errors,
    implementing a highly efficient algorithm for solving the weighted
    orthogonal distance regression problem, i.e., for minimizing the sum of the
    squares of the weighted orthogonal distances between each data point and
    the curve described by the model equation.  It can also be used to solve
    the ordinary least squares problem where all of the errors are attributed
    to the observations of the dependent variable.  A complete description of
    the orthogonal distance regression problem and the algorithm implemented in
    ODRPACK is given by Boggs et al. [1987a and 1987b].

    ODRPACK is designed to handle many levels of user sophistication and
    problem difficulty.

    * It is easy to use, providing two levels of user control of the
      computations, extensive error handling facilities, optional printed
      reports and no size restrictions other than effective machine size.

    * The necessary derivatives (Jacobian matrices) are approximated
      numerically if they are not supplied by the user.

    * The correctness of user supplied derivatives can be verified by the
      derivative checking procedure provided.

    * Both weighted and unweighted analysis can be performed.

    * Subsets of the unknowns can be treated as constants with their values
      held fixed at their input values, allowing the user to examine the
      results obtained by estimating subsets of the unknowns of a general model
      without rewriting the model subroutine.

    * The covariance matrix and the standard errors of the model parameter
      estimators are optionally provided.

    * The ODRPACK scaling algorithm automatically compensates for poorly scaled
      problems, in which the model parameters and/or unknown errors in the
      independent variables vary widely in magnitude.

    * It can accommodate complex data and multiple response data, i.e., data
      where the dependent variable is multi-dimensional.  (See section III.)

    * The trust region Levenberg-Marquardt algorithm implemented by ODRPACK has
      a computational effort per step that is of the same order as that
      required for ordinary least squares, even though the number of unknowns
      estimated in the orthogonal distance regression problem is the number of
      unknown model parameters plus the number of independent variables, while
      the number of unknowns estimated in the ordinary least squares problem is
      simply the number of unknown model parameters.

    * The code is portable and is easily used with other Fortran subroutine
      libraries.

    The following sections describe ODRPACK in greater detail.  Users are
    directed to section II for a brief description of the orthogonal distance
    regression algorithm.  This section introduces notation and provides
    background material for understanding the remainder of the documentation.
    Section III describes how ODRPACK can be used for complex and multiple
    response data, and is only required for users with these data types.
    Section IV describes the need for starting values for BETA and DELTA, and
    section V describes two features of ODRPACK that simplify the user
    interface with the package.  The information in these two sections will be
    especially important to first time users of ODRPACK.  The subroutine
    declaration and call statements are given in section VI and the subroutine
    arguments are defined in section VII.  The sample programs shown in section
    VIII can be used as templates for creating the user's own program.  The
    information provided in section IX describes the scaling algorithm and
    section X describes how the user can extract computed results from the work
    vectors.  The information in these two sections is generally not needed by
    first time users of ODRPACK.



1   II.  BACKGROUND
         ----------

    Let

    Y(I) = FN(X(I,*)+DELTA(I,*);BETA) - EPSILON(I)                       (eq.1)

    for I=1,...,N, where

    N                                 is the number of observations (see
                                      subroutine argument N);

    Y(I), I=1,...,N                   are the observed values of the dependent
                                      variable, where Y(I) depends on X(I,J),
                                      J=1,...,M (see subroutine argument Y);

    FN                                is the function used to predict values of
                                      the dependent variable (see subroutine
                                      argument FUN);

    X(I,J), I=1,...,N & J=1,...,M     are the observed values of the
                                      independent variable (see subroutine
                                      argument X);

    DELTA(I,J), I=1,...,N & J=1,...,M are the unknown errors in X(I,J) that are
                                      to be estimated (see subroutine arguments
                                      JOB and WORK);

    BETA(K), K=1,...,NP               are the function parameters that are to
                                      be estimated (see subroutine argument
                                      BETA);

    EPSILON(I), I=1,...,N             are the unknown errors in Y(I) that are
                                      to be estimated (see subroutine argument
                                      WORK).

    We are assuming that

    observed< Y(I) >    = true< Y(I) >   - true< EPSILON(I) >
    observed< X(I,J) >  = true< X(I,J) > - true< DELTA(I,J) >

    and thus that

    estimated< Y(I) >   = observed< Y(I) >   + estimated< EPSILON(I) >
    estimated< X(I,J) > = observed< X(I,J) > + estimated< DELTA(I,J) >.

1   The square of the weighted orthogonal distance from the point (X(I,*),Y(I))
    to the point FN(X(I,*)+DELTA(I,*);BETA) on the curve described by the model
    equation, i.e., the square of the observation errors, is given by

    R(I)**2 = [FN(X(I,*)+DELTA(I,*);BETA) - Y(I)]**2
                                                                         (eq.2)
                 M
              + SUM [D(I,J)*DELTA(I,J)]**2
                J=1

    for I = 1,...,N, where

    D(I,J), I=1,...,N & J=1,...,M     are the DELTA weights, which can be used
                                      to compensate for instances when the
                                      precision of the X observations is
                                      different from that of the Y observations
                                      (see subroutine argument WD).

    The least squares orthogonal distance solution is then that which minimizes
    with respect to BETA and DELTA the weighted sum of the squared observation
    errors,

     N
    SUM [ ( W(I) * R(I) )**2 ]                                           (eq.3)
    I=1

    where

    W(I), I=1,...,N                   are the observation error weights, which
                                      can be used to compensate for unequal
                                      precision in the observation errors, R(I)
                                      (see subroutine argument W).

    The solution is found using a trust region Levenberg-Marquardt method
    [Boggs et al., 1987b], with scaling used to accommodate problems in which
    estimated values have widely varying magnitudes.  The Jacobian matrices,
    i.e., the matrices of first partial derivatives of FN with respect to each
    BETA and each X, are computed at every iteration either by finite
    differences or by a user supplied subroutine, as specified by subroutine
    argument JOB (see section VII.B).  The iterations are stopped when any one
    of three stopping criteria are met.  Two of these indicate the iterations
    have converged to a solution.  These are "sum of squares convergence",
    which indicates that the change in the weighted sum of the squared
    observation errors is sufficiently small, and "parameter convergence",
    which indicates the change in the values of BETA and DELTA is sufficiently
    small.  The third stopping criteria is a limit on the number of
    iterations.



1   III.  MULTIPLE RESPONSE DATA
          ----------------------

    Since its initial release, users have been interested in applying ODRPACK
    to complex data and to multiple response data in general.  Although ODRPACK
    was written for single response data, where only one dependent variable is
    observed for each independent variable, it is possible to use it to handle
    multiple response data, where the dependent variable is multi-dimensional.
    Complex dependent data falls under the category of multiple response data
    since the real and imaginary parts of the dependent variable must be
    treated as separate observations.

    Let Y(I,L), L=1,...,Q be the Q responses for the Ith observation of the
    independent variable, X(I,*).  These Q multiple responses of the dependent
    variable cannot simply be treated as Q separate observations as can be done
    for ordinary least squares because ODRPACK would then treat the independent
    variables associated with these Q observations as unrelated and thus not
    constrain the errors DELTA(I,*) to be the same for each of the Q
    occurrences of X(I,*).  In the multiple response case, therefore, the
    square of the observation errors (eq.2) must be defined as

               Q
    R(I)**2 = SUM (C(I,L)*[FN(X(I,*)+DELTA(I,*);BETA) - Y(I,L)])**2
              L=1
                                                                         (eq.4)
                 M
              + SUM [D(I,J)*DELTA(I,J)]**2
                J=1

    for I = 1,...,N, where

    FN(X(I,*)+DELTA(I,*);BETA)-Y(I,L) is the estimated error in the Lth
                                      response of the Ith observation of the
                                      dependent variable, and

    C(I,L), I=1,...,N & L=1,...,Q     must be appropriately chosen based on the
                                      desired weights for the individual
                                      response functions.

    Equation (eq.4) has the effect of collapsing the Q errors associated with
    Y(I,L),L=1,...,Q, into a single value.  This implies that NP must be less
    than or equal to N, rather than less than or equal to N*Q as would be the
    case if the multiple response problem were handled directly by ODRPACK or
    the problem were solved using ordinary least squares.  Future plans for
    ODRPACK include modifications that will allow multiple response data to be
    handled directly, thus eliminating this restriction.

1   ODRPACK actually computes the results specified by (eq.2) using
 
                                    M
    R(I)**2 = [<F(I)>-<Y(I)>]**2 + SUM [D(I,J)*DELTA(I,J)]**2            (eq.5)
                                   J=1

    for I = 1,...,N, where

    <F(I)> is the value in the Ith location of vector F returned from the user
           supplied subroutine FUN, which in the single response case contains
           FN(X(I,*)+DELTA(I,*);BETA); and

    <Y(I)> is the value supplied in the Ith location of vector Y of the ODRPACK
           subroutine argument list, which in the single response case contains
           the Ith observation of the dependent variable.

    ODRPACK can thus be "tricked" into solving multiple response orthogonal
    distance regression problems by setting

                   Q
    <F(I)> = sqrt(SUM (C(I,L)*[FN(X(I,*)+DELTA(I,*);BETA) - Y(I,L)])**2) (eq.6)
                  L=1

    for I = 1,...,N, within user supplied subroutine FUN, and setting

    <Y(I)> = 0.0

    for I = 1,...,N.  The computations specified by (eq.5) will then yield the
    value specified by (eq.4) and the multiple response ODR problem will be
    solved correctly.

    Note that this technique for solving multi-response orthogonal distance
    regression problems has the advantage of retaining the original size of the
    problem, i.e., NP parameters and N observations.  It has the disadvantage,
    however, of making the function F a more complicated function of BETA and
    DELTA than the original function FN.  For small data sets, therefore, users
    may want to consider explicitly including each DELTA(I,J) as part of an
    expanded vector BETA and solving the resulting (NP+N*M) parameter problem
    using ordinary least squares as described in Boggs and Donaldson [1989] or
    Fuller [1987].

    Note also that the standard errors of a multi-response orthogonal distance
    regression problem encoded as shown in (eq.6) will not be the same as those
    obtained by solving the problem as an ordinary least squares problem with
    (NP+N*M) parameters because the two functions being minimized have
    different Jacobian matrices at the solution.  (See Section VII.B,
    subroutine argument JOB and IPRINT.)



1   IV.  STARTING VALUES FOR BETA AND DELTA
         ----------------------------------

    Starting values for BETA must be provided by the user.  Users familiar with
    the ordinary nonlinear least squares problem are generally aware of the
    importance of obtaining good starting values for the estimated function
    parameters.  It is equally important to obtain good starting values for the
    parameters when using the orthogonal distance regression technique.  Good
    starting values can significantly decrease the number of iterations
    required to find a solution; a poor starting value may even prevent the
    solution from being found at all.  Reasonable starting values are often
    available from previous analysis or experiments.  When good starting values
    are not readily available, the user may have to do some preliminary
    analysis to obtain them.  Himmelblau [1970] offers several suggestions for
    obtaining starting values when they are not available from other sources.

    When using the technique of orthogonal distance regression it is also
    important to have good starting values for the estimated errors, DELTA, in
    the independent variables.  The ODRPACK default is to initialize DELTA to
    zero, which is the most obvious initial value for the DELTAs.  (Note that
    zero starting values for DELTA do not cause the scaling problems discussed
    in section VII.B that zero starting values for BETA cause.)  Initializing
    the DELTAs to zero, however, is equivalent to initially assigning all of
    the errors to the dependent variable as is done for ordinary least
    squares.  While initializing the DELTAs to zero is quite adequate in many
    cases, in others it is not.  A plot of the curve described by the model
    function and observed data for the initial parameters may indicate whether
    or not zero starting values for DELTA are reasonable.  Often it is visually
    possible to determine better starting values for the DELTAs, especially
    when an asymptote is involved.  For example, in the case of an asymptote,
    the user may need to initialize some of the DELTAs to the horizontal
    distance to the curve, while leaving the other DELTAs initialized to zero
    in order to obtain a reasonable solution.  This problem is discussed
    further in [Boggs et al., 1987b].  As noted there, proper initialization of
    DELTA can mean the difference between solving a difficult problem and not
    solving it.



1   V.  DEFAULT VALUES AND STRUCTURED ARGUMENTS
        ---------------------------------------

    ODRPACK uses default values and structured arguments to simplify the user
    interface.  The availability of default values in ODRPACK means that the
    user does not have to be concerned with determining values for many of the
    ODRPACK arguments unless the problem being solved requires the use of
    nondefault values.  Structured arguments, which exploit the possibly
    symmetric structure of the independent variable data, reduce the amount of
    storage space required for arguments and reduce the work required by the
    user to initialize those arguments.

    DEFAULT VALUES.  Default values have been specified for ODRPACK subroutine
    arguments wherever feasible.  These default values are invoked by setting
    the argument to any negative value.  Arrays with default values are invoked
    by setting the first element of the array to a negative value, in which
    case only the first value of the array will ever be used.  This allows a
    scalar to be used to invoke the default values of arrays, thus saving space
    and the need to declare such arrays.

    Users are encouraged to invoke the default values of arguments wherever
    possible.  The default values have been found to be reasonable for a wide
    class of problems.  Their use will greatly simplify the initial use of
    ODRPACK for a given problem.  Fine tuning of these arguments can then be
    done later if it is found necessary.

    STRUCTURED ARGUMENTS.  Structured arguments are included in ODRPACK because
    the properties of the individual elements of the possibly multiple column
    independent variable data are often constant throughout a given column of
    the independent variable or even throughout the whole independent variable
    matrix.  For example, section II introduces the DELTA weights, specified by
    subroutine argument WD, that indicate how the DELTA and EPSILON for each
    observation (X,Y) are to be weighted in the weighted orthogonal distance.
    If each row of the independent variable indicates an hourly temperature
    reading and each column a different day on which the temperature readings
    were taken, then the user would probably want to weight each of the DELTAs
    equally.  If one column of the independent variable contained hourly
    temperature readings and the other hourly humidity readings, then the user
    might want to weight each of the DELTAs in the first column the same, and
    to weight each of the DELTAs in the second column the same, but not
    necessarily want to weight the two columns equally.  Of course, in other
    cases, the user might want to weight each of the DELTAs differently.

    ODRPACK structured arguments exploit this possible symmetry as follows.  If
    each of the N by M elements of an array describing some property of the
    independent variable are identically equal, then a single value can be used
    to specify all N by M elements.  If the values of such an array only vary
    between columns, then each column of the array can be specified by a single
    value.  Thus, it is only necessary to supply all N by M elements of the
    structured argument array when the elements of one or more of the columns
    must be individually specified.

1   The use of ODRPACK structured arguments is summarized as follows.

    Structure of      Encoding of      Accessed      Resulting
    property P to     structured       elements of   assignment of
    be specified      argument A and   structured    property P
    by structured     its leading      argument A
    argument A        dimension LDA
    ---------------   --------------   -----------   -----------------
    Property P        A(1,1) < zero    A(1,1)        P(I,J) = -A(1,1),
    constant          with                           I=1,...,N &
    throughout        LDA = 1 or                     J=1,...,M
    independent       LDA >= N
    variable matrix

    Property P        A(1,1) >= zero   A(1,J),       P(I,J) = A(1,J),
    varies only       with             J=1,...,M     I=1,...,N &
    between columns   LDA = 1                        J=1,...,M
    of independent
    variable matrix

    Property P        A(1,1) >= zero   A(I,J),       P(I,J) = A(I,J),
    varies between    with             I=1,...,N &   I=1,...,N &
    and within        LDA >= N         J=1,...,M     J=1,...,M
    columns of
    independent
    variable matrix

    If the first element of the structured argument is negative, then each of
    the N by M elements described by the argument is set to the absolute value
    of the first element.  In this case, only the first element of the
    structured argument is ever referenced, allowing the user to set the N by M
    elements using only a scalar.  (Note that in this case, setting the first
    element to a negative value does not necessarily invoke a default value.)
    This feature thus saves space and the need to declare the structured
    argument as an array.

    If the first element of the structured argument is positive, then the way
    the structured argument will be used to designate the N by M values
    specified by it will depend its leading dimension.  The leading dimension
    of the structured argument can be either exactly equal to one, or greater
    than or equal to N.  When the leading dimension is exactly equal to one,
    the structured argument must be passed to ODRPACK as a one by M row vector
    containing the M values used to set each of the M columns.  When the
    leading dimension is greater than or equal to N, the structured argument
    passed to ODRPACK must contain an N by M array of values.



1   VI.  SUBROUTINE DECLARATION AND CALL STATEMENTS
         ------------------------------------------

    The declaration and call statements for ODRPACK's user callable routines,
    SODR, SODRC, DODR and DODRC, are given below.  SODR and SODRC invoke the
    single precision version of the code and DODR and DODRC invoke the double
    precision version.  SODR and DODR preset many arguments to their default
    values and therefore have shorter call statements than SODRC and DODRC.
    SODRC and DODRC have expanded call statements that give the user greater
    control in solving the orthogonal distance regression problem.  The
    information in this section is provided primarily for reference.  Users are
    directed to section VII for example programs.  These examples, which use
    Fortran PARAMETER statements to dimension ODRPACK arrays, provide a
    recommended format for creating an ODRPACK driver that will allow future
    changes to be made easily.

    Note that although ODRPACK is distributed in both single precision and
    double precision versions, both versions may not be available to the user.
    In addition, even when both versions are available, the single precision
    version may not be appropriate to use.  This is because ODRPACK is
    sensitive to the machine's precision, and requires approximately 14 decimal
    places.  Somewhat fewer places should still work, but six or seven decimal
    places are definitely too few for general use, since only the simplest
    problems could be solved correctly at such reduced precisions.

    When both versions are available, the user must choose which version of
    ODRPACK to use based upon which version supplies adequate precision on the
    target machine.  To our knowledge, at present only Cray and CDC machines
    offer sufficient precision to permit general use of the single precision
    version of ODRPACK.  For other machines, we recommend the double precision
    version.

    If both versions of ODRPACK have sufficient precision on the user's
    machine, then either may be used.  When both the single and double
    precision versions are available, however, there are trade offs between
    them.  The double precision version will offer greater accuracy in results,
    while the single precision version will require less storage and possibly
    less machine time.

1   SODR:   Compute the weighted orthogonal distance regression or ordinary
            linear or nonlinear least squares solution in single precision.
            (SODR is appropriate for general use only on machines with
            approximately 14 decimal places of precision for single precision.)
            Derivatives are either supplied by the user or numerically
            approximated by ODRPACK.  Control values are preset, and a three
            part report of the results can be optionally generated.


                PROGRAM MAIN
                .
                .
                .
                EXTERNAL
               +   FUN,JAC
                INTEGER
               +   N,M,NP,
               +   LDX,
               +   LDWD,
               +   JOB,
               +   IPRINT,LUNERR,LUNRPT,
               +   LWORK,IWORK(LIWORK),LIWORK,
               +   INFO
                REAL
               +   X(LDX,M),
               +   Y(N),
               +   BETA(NP),
               +   WD(LDWD,M),
               +   WORK(LWORK)
                .
                .
                .
                CALL SODR
               +   (FUN,JAC,
               +   N,M,NP,
               +   X,LDX,
               +   Y,
               +   BETA,
               +   WD,LDWD,
               +   JOB,
               +   IPRINT,LUNERR,LUNRPT,
               +   WORK,LWORK,IWORK,LIWORK,
               +   INFO)
                .
                .
                .
                END

1   SODRC:  Compute the weighted orthogonal distance regression or ordinary
            linear or nonlinear least squares solution in single precision.
            (SODRC is appropriate for general use only on machines with
            approximately 14 decimal places of precision for single precision.)
            Derivatives are either supplied by the user or numerically
            approximated by ODRPACK.  Control values are supplied by the user,
            and a three part report of the results can be optionally
            generated.

                PROGRAM MAIN
                .
                .
                .
                EXTERNAL
               +   FUN,JAC
                INTEGER
               +   N,M,NP,
               +   LDX,IFIXX(LDIFX,M),LDIFX,LDSCLD,
               +   IFIXB(NP),
               +   LDWD,
               +   JOB,NDIGIT,
               +   MAXIT,
               +   IPRINT,LUNRPT,LUNERR,
               +   LWORK,IWORK(LIWORK),LIWORK,
               +   INFO
                REAL
               +   X(LDX,M),SCLD(LDSCLD,M),
               +   Y(N),
               +   BETA(NP),SCLB(NP),
               +   WD(LDWD,M),W(N),
               +   TAUFAC,
               +   SSTOL,PARTOL,
               +   WORK(LWORK)
                .
                .
                .
                CALL SODRC
               +   (FUN,JAC,
               +   N,M,NP,
               +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
               +   Y,
               +   BETA,IFIXB,SCLB,
               +   WD,LDWD,W,
               +   JOB,NDIGIT,TAUFAC,
               +   SSTOL,PARTOL,MAXIT,
               +   IPRINT,LUNERR,LUNRPT,
               +   WORK,LWORK,IWORK,LIWORK,
               +   INFO)
                .
                .
                .
                END

1   DODR:   Compute the weighted orthogonal distance regression or ordinary
            linear or nonlinear least squares solution in double precision.
            Derivatives are either supplied by the user or numerically
            approximated by ODRPACK.  Control values are preset, and a three
            part report of the results can be optionally generated.

                PROGRAM MAIN
                .
                .
                .
                EXTERNAL
               +   FUN,JAC
                INTEGER
               +   N,M,NP,
               +   LDX,
               +   LDWD,
               +   JOB,
               +   IPRINT,LUNERR,LUNRPT,
               +   LWORK,IWORK(LIWORK),LIWORK,
               +   INFO
                DOUBLE PRECISION
               +   X(LDX,M),
               +   Y(N),
               +   BETA(NP),
               +   WD(LDWD,M),
               +   WORK(LWORK)
                .
                .
                .
                CALL DODR
               +   (FUN,JAC,
               +   N,M,NP,
               +   X,LDX,
               +   Y,
               +   BETA,
               +   WD,LDWD,
               +   JOB,
               +   IPRINT,LUNERR,LUNRPT,
               +   WORK,LWORK,IWORK,LIWORK,
               +   INFO)
                .
                .
                .
                END

1   DODRC:  Compute the weighted orthogonal distance regression or ordinary
            linear or nonlinear least squares solution in double precision.
            Derivatives are either supplied by the user or numerically
            approximated by ODRPACK.  Control values are supplied by the user,
            and a three part report of the results can be optionally
            generated.

                PROGRAM MAIN
                .
                .
                .
                EXTERNAL
               +   FUN,JAC
                INTEGER
               +   N,M,NP,
               +   LDX,IFIXX(LDIFX,M),LDIFX,LDSCLD,
               +   IFIXB(NP),
               +   LDWD,
               +   JOB,NDIGIT,
               +   MAXIT,
               +   IPRINT,LUNRPT,LUNERR,
               +   LWORK,IWORK(LIWORK),LIWORK,
               +   INFO
                DOUBLE PRECISION
               +   X(LDX,M),SCLD(LDSCLD,M),
               +   Y(N),
               +   BETA(NP),SCLB(NP),
               +   WD(LDWD,M),W(N),
               +   TAUFAC,
               +   SSTOL,PARTOL,
               +   WORK(LWORK)
                .
                .
                .
                CALL DODRC
               +   (FUN,JAC,
               +   N,M,NP,
               +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
               +   Y,
               +   BETA,IFIXB,SCLB,
               +   WD,LDWD,W,
               +   JOB,NDIGIT,TAUFAC,
               +   SSTOL,PARTOL,MAXIT,
               +   IPRINT,LUNERR,LUNRPT,
               +   WORK,LWORK,IWORK,LIWORK,
               +   INFO)
                .
                .
                .
                END



1   VII.   SUBROUTINE ARGUMENT DESCRIPTIONS
           --------------------------------

    VII.A  Synopsis

    The arguments of the ODRPACK user callable subroutines are logically
    grouped as shown below.  Arguments shown in parenthesis (...) are not
    included in the SODR and DODR call statements; SODR and DODR automatically
    preset these variables to the default values given in section VII.B.  All
    other arguments are common to all ODRPACK user callable subroutines.

    Argument
      Number   Arguments                            Group Description
    --------   ---------                            -----------------

      1 to 2   FUN,JAC,                             Names of user supplied
                                                    subroutines for function
                                                    and Jacobian matrix
                                                    computation

      3 to 5   N,M,NP,                              Problem size specification

     6 to 11   X,LDX,(IFIXX,LDIFX,SCLD,LDSCLD,)     Independent variable
                                                    information

          12   Y,                                   Dependent variable

    13 to 15   BETA,(IFIXB,SCLB,)                   Function parameter
                                                    information

    16 to 18   WD,LDWD,(W,)                         Weights

    19 to 21   JOB,(NDIGIT,TAUFAC,)                 Computation and
                                                    initialization control

    22 to 24   (SSTOL,PARTOL,MAXIT,)                Stopping criteria

    25 to 27   IPRINT,LUNERR,LUNRPT,                Print control

    28 to 31   WORK,LWORK,IWORK,LIWORK,             Work vectors and returned
                                                    results

          32   INFO                                 Stopping condition



1   VII.B  Detailed Descriptions of
           ODRPACK User Callable Subroutine Arguments

    The arguments of ODRPACK's user callable subroutines are described below in
    order of their occurrence in the call statements.  Appropriate declaration
    statements for each argument are shown in brackets [...] following the
    argument name; the character string <real> denotes REAL when using single
    precision subroutines SODR and SODRC, which should be used only on machines
    with approximately 14 decimal digits of precision in single precision, and
    denotes DOUBLE PRECISION when using double precision subroutines DODR and
    DODRC.  Each argument is numbered as shown in section VII.A, allowing the
    user to easily find the definition of a specific argument.  In addition,
    three common characteristics of ODRPACK subroutine arguments are flagged in
    the left margin by the argument number.  The flags are:

    C  which indicates the argument is only included in the call statements for
       SODRC and DODRC (SODR and DODR will preset these variables to their
       default values);

    D  which indicates the argument has a default value that can be invoked by
       setting the argument to any negative value; and

    S  which indicates the argument exploits possible symmetry in the
       properties of the independent variables as described in section IV.


                                        NOTE

               Substitute REAL for <real> when using SODR and SODRC.

         Substitute DOUBLE PRECISION for <real> when using DODR and DODRC.

                                        ****



1       1. FUN [EXTERNAL FUN]

           The name of the user supplied subroutine that computes the predicted
           values, F, of the dependent variable given the current values of the
           independent variable, XPLUSD=X+DELTA, and the function parameters,
           BETA.  The subroutine argument list and declaration statements must
           be exactly as shown below.

                 SUBROUTINE FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
           C
           C  INPUT ARGUMENTS
           C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
           C
                 INTEGER N,NP,M,LDXPD
                 <real> BETA(NP),XPLUSD(LDXPD,M)
           C
           C  OUTPUT ARGUMENTS
           C
                 INTEGER ISTOPF
                 <real> F(N)

                 < computations for F(I)=FN(XPLUSD;BETA), I=1,...,N >

                 < set ISTOPF = 0 if the current estimates of BETA and XPLUSD >
                 <                   were acceptable for use in subroutine FUN>
                 <                   and the regression procedure should      >
                 <                   continue                                 >
                 <            > 0 if the current estimates of BETA and XPLUSD >
                 <                   were not acceptable for use in subroutine>
                 <                   FUN, and values closer to the most       >
                 <                   recently tried acceptable values of BETA >
                 <                   and XPLUSD should be used                >
                 <            < 0 if the regression procedure should be       >
                 <                   stopped immediately                      >

                 RETURN
                 END

           where

           INTEGER N
              is the number of observations, i.e., the number of points (X,Y).
           INTEGER NP
              is the number of function parameters, i.e., the number of values
              in vector BETA.
           INTEGER M
              is the number of columns of data in the independent variable
              matrix XPLUSD.
           <real> BETA(NP)
              is the singly subscripted array that contains the current values
              of the NP function parameters.
           <real> XPLUSD(LDXPD,M)
              is the doubly subscripted array that contains the current value
              of the N by M matrix of the independent variables, i.e.,
              XPLUSD = X + DELTA.
           INTEGER LDXPD
              is the leading dimension of array XPLUSD.
           <real> F(N)
              is the singly subscripted array that contains the N predicted
              values of the function given the current values of the function
              parameters and the independent variables, i.e.,
              F = FN(XPLUSD;BETA).
           INTEGER ISTOPF
              is an indicator value that can be used to reject the current
              estimates of BETA and XPLUSD as unacceptable.  Upon return from
              subroutine FUN:
              If ISTOPF = 0 then
                 the current estimates of BETA and XPLUSD were acceptable for
                 use in subroutine FUN, and the values of the predicted values
                 F were properly computed.  The regression procedure will
                 continue.
              If ISTOPF > 0 then
                 the values of the predicted values F could not be properly
                 computed because the current estimates of BETA and XPLUSD were
                 not acceptable.  The regression procedure will select values
                 closer to the most recently tried acceptable values of BETA
                 and XPLUSD.
              If ISTOPF < 0 then
                 the regression procedure should be stopped immediately.  The
                 final summary of the computation report will be printed,
                 however, if it has been requested (see argument IPRINT).


         2. JAC [EXTERNAL JAC]

           The name of the user supplied subroutine that computes the Jacobian
           matrices, i.e., the matrices of first partial derivatives of FN with
           respect to each BETA and each X.  This subroutine must be supplied
           only when digit C of JOB is nonzero (see subroutine argument JOB)
           although the external statement must always be provided in the
           user's main program; when digit C of JOB is zero the necessary
           Jacobian matrices will be computed by ODRPACK using finite
           differences.

           Note that the logical argument ISODR, which is passed to subroutine
           JAC by ODRPACK, can be used to avoid computing the Jacobian matrix
           with respect to X when the fit is by the method of ordinary least
           squares and these derivatives are not needed.  ISODR will be "false"
           in this case.  It is not an error to compute the Jacobian with
           respect to X when the fit is by the method of ordinary least
           squares; it is an error if the Jacobian with respect to X is not
           computed when the fit is by the method of orthogonal distance
           regression.

           The subroutine argument list and dimension statements must be
           exactly as shown below.

1                SUBROUTINE JAC(N,NP,M,BETA,XPLUSD,LDXPD,
                +               FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOPJ)
           C
           C  INPUT ARGUMENTS
           C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
           C
                 INTEGER N,NP,M,LDXPD
                 LOGICAL ISODR
                 <real> BETA(NP),XPLUSD(LDXPD,M)
           C
           C  OUTPUT ARGUMENTS
           C
                 INTEGER ISTOPJ
                 <real> FJACB(LDFJB,NP),FJACX(LDFJX,M)

                 < computations for FJACB(I,K)=first partial derivative of FN
                                               with respect to BETA(K),
                                               K=1,...,NP, at each observation
                                               I=1,...,N >

                 IF (ISODR) THEN

                 < computations for FJACX(I,J)=first partial derivative of FN
                                               with respect to X(I,J),
                                               J=1,...,M at each observation
                                               I=1,...,N >

                 END IF

                 < set ISTOPJ =  0 if the current estimates of BETA and XPLUSD>
                 <                    were acceptable for use in subroutine   >
                 <                    JAC and the regression procedure should >
                 <                    continue                                >
                 < set ISTOPJ <> 0 if the regression procedure should be      >
                 <                    stopped immediately                     >

                 RETURN
                 END

           where

           INTEGER N
              is the number of observations, i.e., the number of points (X,Y).
           INTEGER NP
              is the number of function parameters, i.e., the number of values
              in vector BETA.
           INTEGER M
              is the number of columns of data in the independent variable
              matrix XPLUSD.
           <real> BETA(NP)
              is the singly subscripted array that contains the current values
              of the NP function parameters.
           <real> XPLUSD(LDXPD,M)
              is the doubly subscripted array that contains the current value
              of the N by M matrix of the independent variables, i.e.,
              XPLUSD = X + DELTA.
           INTEGER LDXPD
              is the leading dimension of array XPLUSD.
           <real> FJACB(LDFJB,NP)
              is the doubly subscripted array that contains the N by NP matrix
              of derivatives with respect to BETA at the current values of the
              function parameters and the independent variables.
           INTEGER LDFJB
              is the leading dimension of array FJACB.
           LOGICAL ISODR
              is a control value that can be used to inhibit the computation
              of the derivatives with respect to X when the solution is being
              computed by ordinary least squares and the derivatives with
              respect to X are not needed.
              If ISODR is true then
                 the solution is being computed by ODR and the derivatives with
                 respect to X must be computed
              else
                 the solution is being computed by OLS and the derivatives with
                 respect to X are not needed.
           <real> FJACX(LDFJX,M)
              is the doubly subscripted array that contains the N by M matrix
              of derivatives with respect to X at the current values of the
              function parameters and the independent variables, needed only
              when ISODR = true.
           INTEGER LDFJX
              is the leading dimension of array FJACX.
           INTEGER ISTOPJ
              is an indicator value that can be used to reject the current
              estimates of BETA and XPLUSD as unacceptable.  Upon return from
              subroutine JAC:
              If ISTOPJ = 0 then
                 the current estimates of BETA and XPLUSD were acceptable for
                 use in subroutine JAC, and the Jacobians were properly
                 computed.  The regression procedure will continue.
              Else
                 the regression procedure should be stopped immediately.  The
                 final summary of the computation report will be printed,
                 however, if it has been requested (see argument IPRINT).


        3. N [INTEGER N]

           The number of observations, i.e., the number of points (X,Y).  (See
           subroutine arguments X and Y.)


        4. M [INTEGER M]

           The number of columns of data in the independent variable matrix X.
           (See subroutine argument X.)


        5. NP [INTEGER NP]

           The number of function parameters, i.e., the number of values in
           vector BETA.  (See subroutine argument BETA).


        6. X [<real> X(LDX,M)]

           The doubly subscripted array that contains the observed values of
           the N by M matrix of independent variables.


        7. LDX [INTEGER LDX]

           The leading dimension of array X.

           LDX must equal or exceed N; values of LDX less than N will be
           treated as an input error.


    CDS 8. IFIXX [INTEGER IFIXX(LDIFX,M)]

           The doubly subscripted array that contains the indicator values used
           to designate whether element X(I,J), I=1,...,N & J=1,...,M, of the
           independent variable matrix is to treated as without error, i.e.,
           DELTA(I,J) is to be fixed at zero, or whether the error DELTA(I,J)
           in that observation of the independent variable is to be estimated.

           By default, all of the independent variables are treated as
           "unfixed", i.e.  the errors DELTA(I,J) are estimated for all
           I=1,...,N & J=1,...,M.  The default value is invoked when IFIXX(1,1)
           is set to any negative value.  Other options for specifying IFIXX
           are described below.

           If IFIXX(1,1) >= 0 then

              the way IFIXX is used depends on the value of the leading
              dimension of IFIXX, i.e., on LDIFX.

              If LDIFX = 1 then

                 IFIXX must contain a 1 by M matrix of values, where for
                 J=1,...,M

                    if IFIXX(1,J) = 0 then

                       X(I,J), I=1,...,N, is treated as exact and
                       DELTA(I,J), I=1,...,N, is fixed at zero

                    else

                       X(I,J), I=1,...,N, is treated as approximate and
                       DELTA(I,J), I=1,...,N, is estimated.

              If LDIFX >= N then

                 IFIXX must contain an N by M matrix of values, where for
                 I=1,...,N & J=1,...,M

                    if IFIXX(I,J) = 0 then

                       X(I,J) is treated as exact and DELTA(I,J) is fixed at
                       zero

                    else

                       X(I,J) is treated as approximate and DELTA(I,J) is
                       estimated.

           If IFIXX(1,1) < 0 then

              the default option is invoked, i.e., each observation of the
              independent variable, X(I,J), is treated as being measured with
              error an DELTA(I,J) that is estimated as described above in
              section II.  In this case, only the first element of IFIXX is
              ever referenced and IFIXX can be a scalar.


      C 9. LDIFX [INTEGER LDIFX]

           The leading dimension of array IFIXX.

           LDIFX must exactly equal one or must equal or exceed N; values of
           LDIFX less than one or between two and N-1, inclusive, will be
           treated as an input error.

           See subroutine argument IFIXX for further details.


   CDS 10. SCLD [<real> SCLD(LDSCLD,M)]

           The doubly subscripted array that contains the scale values of the
           errors in the independent variable, i.e., the reciprocals of the
           expected magnitudes or typical sizes of DELTA(I,J), I=1,...,N &
           J=1,...,M. 

           Scaling is used within the regression procedure in order that the
           units of the variable space will have approximately the same
           magnitude.  In particular, the scale value times the corresponding
           value of DELTA should be approximately one.  For example, if
           DELTA(1,1) is expected to lie between -10E10 and 10E10 then
           SCLD(1,1) should be set to 10E-10, while if DELTA(1,1) is expected
           to lie between -10E-2 and -10E-4 then SCLD(1,1) should be set to
           10E3.  (The reciprocal of the standard errors of the observation
           X(I,J) can be used as SCLD(I,J) if the standard errors are known.)
           Except as noted in the next paragraph, the scale values specified
           for each DELTA must be greater than zero; values less than or equal
           to zero will be treated as an input error.

           By default, the scale values will be set using the algorithm given
           in section IX.B.  The default values are invoked when SCLD(1,1) is
           set to any negative value.  Other options for specifying SCLD are
           described below.

           If SCLD(1,1) > 0 then

              each value of SCLD must be greater than zero and the way SCLD is
              used depends on the value of the leading dimension of SCLD, i.e.,
              on LDSCLD.

              If LDSCLD = 1 then

                 SCLD must contain a 1 by M matrix of values, and the scale of
                 DELTA(I,J), I=1,...,N, is set to SCLD(1,J) for J=1,...,M.

              If LDSCLD >= N then

                 SCLD must contain an N by M matrix of values, and the scale of
                 DELTA(I,J) is set to SCLD(I,J) for I=1,...,N & J=1,...,M.

           If SCLD(1,1) <= 0 then

              the default option is invoked and each DELTA(I,J) is scaled as
              described in section IX.B.  In this case, only the first element
              of SCLD is ever referenced and SCLD can be a scalar.


      C11. LDSCLD [INTEGER LDSCLD]

           The leading dimension of array SCLD.

           LDSCLD must exactly equal one or must equal or exceed N; values of
           LDSCLD less than one or between two and N-1, inclusive, will be
           treated as an input error.

           See subroutine argument SCLD for further details.


       12. Y [<real> Y(N)]

           The singly subscripted array that contains the N observed values of
           the dependent variable.  (See section III for a discussion of how to
           handle multiple response data.)


       13. BETA [<real> BETA(NP)]

           The singly subscripted array that contains the (current) values of
           the NP function parameters.

           On input:   BETA must contain initial approximations for the
                       function parameters.  Initial approximations should be
                       chosen with care since poor initial approximations can
                       significantly increase the number of iterations required
                       to find a solution and possibly prevent the solution
                       from being found at all.

                       Users who do not provide scale information are strongly
                       encouraged not to use zero as an initial approximation
                       since a zero value can result in incorrect scale value
                       selection by the scaling algorithm (see section IX).
                       Setting the initial approximation to the largest
                       magnitude that, for the user's problem, is effectively
                       zero rather than the actual value zero will eliminate
                       scaling problems, possibly producing faster
                       convergence.  For example, if BETA(1) represents change
                       in cost in millions of dollars, then the value 10.0
                       might be considered "effectively zero", while if BETA(1)
                       represents the change in cost in tens of dollars, then
                       the value 0.01 might be considered "effectively zero."

           On return:  BETA contains the "best" estimate of the solution at the
                       time the computations stopped.


    CD 14. IFIXB [INTEGER IFIXB(NP)]

           The singly subscripted array that contains the indicator values used
           to designate whether the corresponding value in BETA is to be
           treated as a fixed constant or is to be estimated.

           By default, all of the function parameters, BETA, are treated as
           "unfixed", i.e.  each of the BETA(K), K=1,...,NP, is estimated.  The
           default value is invoked when IFIXB(1) is set to any negative
           value.  Other options for specifying IFIXB are described below.

           If IFIXB(1) >= 0 then

              IFIXB must contain a vector of NP values, where for K=1,...,NP

                 if IFIXB(K) = 0 then

                    BETA(K) will be held fixed at its input value

                 else

                    BETA(K) will be estimated as described above.

           If IFIXB(1) < 0 then

              the default option is invoked, i.e., all BETA(K), K=1,...,NP,
              will be estimated as described above in section II.  In this
              case, only the first element of IFIXB is ever referenced and
              IFIXB can be a scalar.


    CD 15. SCLB [<real> SCLB(NP)]

           The singly subscripted array that contains the scale values of the
           function parameters, i.e., the reciprocals of the expected
           magnitudes or typical sizes of BETA(K), K=1,...,NP. 

           Scaling is used within the regression procedure in order that the
           units of the variable space will have approximately the same
           magnitude.  In particular, the scale value times the corresponding
           value of BETA should be approximately one.  For example, if BETA(1)
           is expected to lie between -10E10 and 10E10 then SCLB(1) should be
           set to 10E-10, while if BETA(1) is expected to lie between -10E-2
           and -10E-4 then SCLB(1) should be set to 10E3.  Except as noted in
           the next paragraph, the scale values specified for each BETA must be
           greater than zero; values less than or equal to zero will be treated
           as an input error.

           By default, the scale values will be set using the algorithm given
           in section IX.A.  The default values are invoked when SCLB(1) is set
           to any nonpositive value.  If SCLB(1) > 0 then SCLB must contain a
           vector of NP values each greater than zero and the scale of BETA(K)
           is set to SCLB(K) for K=1,...,NP.


     S 16. WD [<real> WD(LDWD,M)]

           The doubly subscripted array that contains the values that specify
           the DELTA weights, D, which indicate how the DELTAs and EPSILONs of
           the observation (X,Y) are to be weighted in the weighted orthogonal
           distance, R (see eq.2).  For example, WD(I,J) might be the the ratio
           of the precision of the Y(I) observation to that of the X(I,J) 
           observation.

           All elements of WD must be nonzero.

           If WD(1,1) < zero then

              only the first element of WD is ever referenced (in this case, WD
              can be a scalar) and

                 D(I,J) = ABS(WD(1,1)) for I=1,...,N & J=1,...,M,

              i.e., D(I,J) is constant and every DELTA is weighted equally with
              respect to each of the EPSILONs.  When ABS(WD(1,1)) = 1, the
              DELTAs and EPSILONs are both weighted equally, possibly
              indicating the X and Y observations are equally precise.

           If WD(1,1) > zero then

              then all elements of WD must be greater than zero and the way WD
              is used to specify D depends on the value of the leading
              dimension of WD, i.e., on LDWD.

              If LDWD = 1 then

                 WD must contain a 1 by M matrix of values, where for J=1,...,M

                    D(I,J) = WD(1,J), I=1,...,N,

                 i.e., each column of D is constant.  In this case, all
                 elements of a given column of DELTA are weighted equally with
                 respect to EPSILON, possibly reflecting that each observation
                 within a given column of X is equally precise, but that the
                 precision between columns varies.

              If LDWD >= N then

                 WD must contain an N by M matrix of values, where

                    D(I,J) = WD(I,J) for I=1,...,N & J=1,...,M,

                 i.e., each element of D is individually specified, possibly
                 indicating that the individual observations of X vary
                 significantly in precision both from each other and from the
                 corresponding observations of Y.


       17. LDWD [INTEGER LDWD]

           The leading dimension of array WD.

           LDWD must exactly equal one or must equal or exceed N; values of
           LDWD less than one or between two and N-1, inclusive, will be
           treated as an input error.

           See subroutine argument WD for further details.


    CD 18. W [<real> W(N)]

           The singly subscripted array that contains the values that specify
           the observation error weights that can be used to compensate for
           unequal precision in the observation errors (see eq.3).

           By default, the observation errors are unweighted, i.e., all of the
           weights are assumed to be identically equal to one.  The default
           value is invoked when W(1) is set to any negative value.  Other
           options for specifying W are described below.

           If W(1) >= zero then

              W must contain a vector of N values, where all elements of W must
              be greater than or equal to zero, and W(I), I=1,...,N, specifies
              the weight for the observation error R(I).  Zero weights
              eliminate the corresponding observation from the analysis.

           If W(1) < zero then

              the default option is invoked, i.e., the observation errors are
              unweighted.  In this case, only the first element of W is ever
              referenced and W can be a scalar.


     D 19. JOB [INTEGER JOB]

           The value used to specify problem initialization and computational
           methods.  The user has the option of specifying five different
           aspects of the problem specification:
              - whether the fit is to be by orthogonal distance regression
                (ODR) or by ordinary least squares (OLS);
              - whether the user has supplied subroutine JAC to compute the
                necessary Jacobian matrices and whether the user supplied
                Jacobian matrices should be checked;
              - whether the covariance matrix should be computed for the
                estimators of BETA;
              - whether the DELTAs have been initialized by the user; and
              - whether the fit is a restart.

           By default:
              - the solution will be found by ODR;
              - the derivatives will be computed by finite differences;
              - the covariance will be computed;
              - the DELTAs will be initialized to zero; and
              - the fit will not be a restart.
           The default value is invoked by setting JOB to any value less than
           zero.

           Setting JOB = 1 will have the same consequence as JOB = -1 except
           that the solution will be found by OLS.

           If JOB > 0 then

              JOB is assumed to be a 5 digit INTEGER with decimal expansion
              ABCDE, where each digit controls a different aspect of the
              problem specification.

              Digit A indicates whether the fit is a restart.

                      A = 0 indicates fit is not a restart.

                      A > 0 indicates fit is a restart.  The computations will
                            continue from where they left off for another 10
                            iterations.  If the fit is a restart then the
                            elements of vector WORK must be exactly as returned
                            from a previous call to ODRPACK.  No error checking
                            will be performed to verify this.

              Digit B indicates whether the DELTAs have been initialized by
                      the user.

                      B = 0 indicates DELTAs have not been initialized by user.
                            The DELTAs will be initialized to zero.

                      B > 0 indicates DELTAs have been initialized by user.
                            (See subroutine argument WORK.)

              Digit C indicates whether the the covariance matrix of the
                      estimators of the parameters BETA should be computed.

                      C = 0 indicates that the covariance matrix should be
                            computed.  (See subroutine argument IPRINT and
                            section X.B.)

                      C > 0 indicates that the covariance matrix should not be
                            computed.

              Digit D indicates whether the user has supplied subroutine JAC to
                      compute the necessary Jacobian matrices and whether the
                      user supplied Jacobian matrices should be checked.

                      D = 0 indicates that the Jacobian matrices are to be
                            computed by finite differences and that subroutine
                            JAC will not be used.

                      D > 0 indicates that the user has supplied subroutine JAC
                            to compute the necessary Jacobian matrices (see
                            subroutine argument JAC).
                            If D = 1 the results of the user supplied routine
                                     will be checked for correctness.
                                     (Derivative checking requires one
                                     evaluation of user supplied subroutine JAC
                                     and at least NP+M evaluations of user
                                     supplied subroutine FUN.)  Users who turn
                                     off the printed error reports by setting
                                     IPRINT=0 or LUNERR=0 should examine the
                                     information returned in IWORK to determine
                                     the results of the derivative checking
                                     procedure.  (See subroutine argument INFO
                                     and section X.B.)
                            If D > 1 the results of the user supplied routine
                                     will not be checked for correctness.

              Digit E indicates whether the fit is to be by orthogonal distance
                      regression (ODR) or by ordinary least squares (OLS).

                      E = 0 indicates an ODR fit.

                      E > 0 indicates an OLS fit.

           If JOB < 0 then

              the "default" value will be used.


    CD 20. NDIGIT [INTEGER NDIGIT]

           The number of reliable decimal digits in the predicted values (F)
           computed by the user's model function.  (See [Gill et al., 1981].) 

           By default, the value for NDIGIT is experimentally determined by
           ODRPACK using the first row of the user's data set that does not
           contain a zero observation.  The computation of NDIGIT requires 5
           evaluations of user supplied subroutine FUN.  The default value is
           invoked when NDIGIT is set to any value outside the range [2,
           DIGITS], where DIGITS is the number of decimal digits carried by the
           user's computer for a single precision value when the SODR or SODRC
           are being used, and is the number carried for a double precision
           value when DODR or DODRC are being used.


    CD 21. TAUFAC [<real> TAUFAC]

           The value used to specify the initializing factor for the trust
           region radius.  The trust region is the region in which the local
           approximation to the user's function is considered to be reliable.
           The diameter of this region is adaptively chosen at each iteration
           based on information from the previous iteration.  At the first
           iteration, the initial diameter is set to the initializing factor
           times the length of the full Gauss-Newton step at the initial
           estimates.

           By default, the initialization factor for the trust region radius is
           one, thus allowing the full Gauss-Newton step to be taken at the
           first iteration if it does, in fact, reduce the weighted sum of
           squares.  The default value is invoked when TAUFAC is set to any
           value less than or equal to zero.

           A value of TAUFAC greater than zero but less than one may be
           appropriate if, at the first iteration, the computed results
           overflow, or the function parameters, BETA, leave the region of
           interest in parameter space.  Values of TAUFAC greater than one have
           the same effect on the computations as a value of one.


    CD 22. SSTOL [<real> SSTOL]

           The value used to specify the stopping tolerance for the convergence
           test based on relative change in the weighted sum of the squared
           observation errors (eq.3).

           The "default" sum of squares convergence stopping tolerance is the
           square root of machine precision, where machine precision is defined
           as the smallest value e such that 1+e>1 on the computer being used.
           The default value is invoked when the user supplied value for SSTOL
           is outside the interval [e,1).


    CD 23. PARTOL [<real> PARTOL]

           The value used to specify the stopping tolerance for the convergence
           test based on relative change in the estimated parameters BETA and
           DELTA.

           By default, the stopping tolerance for parameter convergence is
           (machine precision)**(2/3), where machine precision is defined as
           the smallest value e such that 1+e>1 on the computer being used.
           The default value is invoked when the user supplied value for PARTOL
           is outside the interval [e,1).


    CD 24. MAXIT [INTEGER MAXIT]

           The value used to specify the maximum number of iterations allowed.

           By default, the maximum number of iterations is 50.  The default
           value is invoked when the user supplied value for MAXIT is less than
           or equal to zero.


     D 25. IPRINT [INTEGER IPRINT]

           The value used to control the generated computation reports, which
           are divided into three sections:
              - the initial summary
              - the iteration summary and
              - the final summary.
           The choice of content for each of these sections is described below.

           By default, the computation reports include
              - a "long" initial summary
              - no iteration summary and
              - a "short" final summary
           The default value is invoked when the user supplied value for IPRINT
           is less than zero.

           If IPRINT > 0 then

              IPRINT is assumed to be a 4 digit INTEGER with decimal expansion
              ABCD, where each digit controls a different part of the generated
              reports.

              Digit A indicates whether the initial summary will be generated.

                      A = 0 indicates the initial summary will not be
                            generated.

                      A = 1 indicates a "short" initial summary will be
                            generated that will include

                            * the values N, M and NP, the number of
                              observations with nonzero weights, and the number
                              of BETAs actually being estimated.

                            * the control values JOB, NDIGIT, TAUFAC, SSTOL,
                              PARTOL, and MAXIT.

                            * the weighted sum of the squared observation
                              errors, the sum of the squared weighted DELTAs
                              and the sum of the squared weighted EPSILONs at
                              the initial values of BETA and DELTA.

                      A > 1 indicates a "long" initial summary will be
                            generated, which includes all the information found
                            in the "short" initial summary and, in addition,
                            includes

                            * a summary of the independent variable data,
                              organized by column.

                            * the first and last observation of the dependent
                              variable and the first and last observation error
                              weight.

                            * for each function parameter BETA, the initial
                              value, whether or not the parameter is treated as
                              fixed or not, and the scale value to be used.

              Digit B indicates whether the iteration summary will be
                      generated.

                      B = 0 indicates no iteration summary will be generated.

                      B = 1 indicates a "short" 1 line, 68 column iteration
                            summary will be generated every Cth iteration
                            beginning with iteration one.  This summary will
                            list

                            * the number of function evaluations.

                            * the weighted sum of the squared observation
                              errors at the current point.

                            * the actual relative reduction in the weighted sum
                              of the squared observation errors due to the most
                              recently tried step (used to check for sum of
                              squares convergence).

                            * the predicted relative reduction in the weighted
                              sum of the squared observation errors due to the
                              most recently tried step (used to check for sum
                              of squares convergence).

                            * the ratio of the trust region radius to the norm
                              of the BETAs and DELTAs, which is an upper bound
                              on the relative change in the estimated values
                              possible at the next step (used to check for
                              parameter convergence).

                            * whether the step was a Gauss-Newton step.

                      B > 1 indicates an [NP/3] line, 125 column iteration
                            summary will be generated every Cth iteration
                            beginning with iteration 1.  This summary lists all
                            of the information found in the "short" iteration
                            summary and, in addition, includes

                            * current values of the BETAs.  (Note that, at the
                              last iteration, the values listed for BETA will
                              be those that produced the actual and predicted
                              relative reductions shown only if the most
                              recently tried step did in fact make the fit
                              better.  If not, then the values of BETA are
                              those that produced the best fit.

              Digit C indicates the frequency of the iteration summary.

                      C = 0 indicates no iteration summary will be generated,
                            even if the value of digit B is nonzero.

                      C > 0 indicates an iteration summary will be generated
                            every Cth iteration beginning with iteration one.

              Digit D indicates whether the final summary will be generated.

                      D = 0 indicates the final summary will not be generated.

                      D = 1 indicates a "short" final summary will be
                            generated, which includes

                            * the stopping condition.

                            * the number of iterations, the number of function
                              evaluations and, if the Jacobian was supplied by
                              the user, the number of Jacobian evaluations at
                              the time the computations stopped.

                            * the condition number of the problem at the time
                              the computations stopped.

                            * the rank deficiency of the model at the time the
                              computations stopped.

                            * the final weighted sum of the squared observation
                              errors, the final sum of the squared weighted
                              DELTAs, the final sum of the squared weighted
                              EPSILONs, and if the covariance matrix was
                              computed, the estimated residual variance of the
                              fit, RVAR, and the associated degrees of freedom,
                              DF, where

                                     1     N
                              RVAR = -- * SUM (W(I)*R(I))**2 
                                     DF   I=1

                              DF   = the number of observations with nonzero
                                     weighted derivatives with respect to
                                     either BETA or DELTA minus the number of
                                     parameters actually estimated.

                            * the final values of BETA, and, if the covariance
                              matrix was computed, the standard errors for the
                              estimators of BETA. (See subroutine argument
                              JOB.)  The standard errors are computed as the
                              square root of the diagonal elements of the
                              variance covariance matrix VCV,

                                 VCV = RVAR * inv( trans(FJACB)*OMEGA*FJACB )

                              where

                              RVAR     is defined above;

                              FJACB    is the derivative of
                                       FN(X(I,J)+DELTA(I,J);BETA) with respect
                                       to BETA, evalutated at the solution;

                              OMEGA    is the diagonal matrix which has (I,I)th
                                       element

                                                           W(I)**2
                                       OMEGA(I,I) = ---------------------
                                                         M  FJACX(I,J)**2
                                                    1 + SUM -------------
                                                        J=1   D(I,J)**2

                                       with FJACX(I,J) the derivative of
                                       FN(X(I,J)+DELTA(I,J);BETA) with respect
                                       to DELTA(I,J), evaluated at the solution
                                       (for ordinary least squares, OMEGA(I,I)
                                       reduces to W(I)**2);

                              inv(.)   indicates the inverse of the designated
                                       matrix; and

                              trans(.) indicates the transpose of the
                                       designated matrix.

                              Note that the covariance matrix is an
                              approximation based on a linearization of the
                              model in the neighborhood of the solution.  The
                              validity of the approximation depends on the
                              nonlinearity of the model, the variance and
                              distribution of the errors, and the data itself.
                              Confidence regions and intervals computed using
                              the covariance matrix are often acceptable, but
                              can be very inaccurate in some cases.  When
                              reliable confidence intervals and regions are
                              required, other more accurate, but more
                              computationally expensive methods of constructing
                              them should be used.  (See, e.g., Boggs and
                              Donaldson [1989], Donaldson and Schnabel [1987],
                              Efron [1985], and Fuller [1987].)

                            * the first 32 values of EPSILON, and the first 32
                              values of each column of DELTA.

                      D > 1 indicates a "long" final summary will be generated,
                            which includes the same information as the "short"
                            final summary except that

                            * the values of all of the EPSILONs and DELTAs are
                              listed.

           If IPRINT < 0 then

              the default reports will be generated.

           If IPRINT = 0 then

              the no reports will be generated.


     D 26. LUNERR [INTEGER LUNERR]

           The value used to specify the logical unit number of the file to be
           used for error messages.

           By default, the error messages are generated on unit 6.  The default
           value is invoked when the user supplied value for LUNERR is less
           than zero.

           If LUNERR > 0  the error messages will be generated on unit LUNERR.

           If LUNERR = 0  no error messages will be generated.

           If LUNERR < 0  the "default" unit number will be used.


     D 27. LUNRPT [INTEGER LUNRPT]

           The value used to specify the logical unit number of the file to be
           used for computation reports.

           By default, the computation reports are generated on unit 6.  The
           default value is invoked when the user supplied value for LUNRPT is
           less than zero.

           If LUNRPT > 0  the computation reports will be generated on unit
                          LUNRPT.

           If LUNRPT = 0  no computation reports will be generated.

           If LUNRPT < 0  the "default" unit number will be used.


       28. WORK [<real> WORK(LWORK)]

           The singly subscripted array used for <real> work space and the
           array in which various computed values are returned.  The smallest
           acceptable dimension of WORK is given below in the definition of
           subroutine argument LWORK.

           The work area does not need to be initialized by the user unless the
           user wishes to initialize the DELTAs.

           The first N*M locations of WORK contain the values for DELTA.  An
           easy way to access these values, either for initialization (as
           indicated by digit B of subroutine argument JOB) or for analysis
           upon return from ODRPACK, is to include in the user's program the
           declaration statements

              <real> DELTA(<N>,<M>)
              EQUIVALENCE (WORK(1), DELTA(1,1))

           where <N> indicates the first dimension of the array DELTA must be
                     exactly the number of observations, N; and
                 <M> indicates the second dimension of the array DELTA must be
                     exactly the number of columns, M, of the independent
                     variable, X.

           This allows the error associated with observation X(I,J) of the
           independent variable matrix to be accessed as DELTA(I,J) rather than
           as WORK(I+(J-1)*N).  The input values of array DELTA will be over
           written by the final estimates of the errors in the independent
           variable matrix when this equivalencing method is used.

           Other values returned in array WORK may also be of general interest
           and can be accessed as described below in section X.

           N.B., if the fit is a restart, i.e., if digit A of subroutine
           argument JOB is nonzero, then all elements of vector WORK, including
           the values of DELTA, must be exactly as returned from a previous
           call to ODRPACK.


       29. LWORK [INTEGER LWORK]

           The length of array WORK.  LWORK must equal or exceed

           17 + 7*N + 10*N*M + 2*N*NP + 8*NP .

           Values of LWORK less than this value will be treated as an input
           error.


       30. IWORK [INTEGER IWORK(LIWORK)]

           The singly subscripted array used for INTEGER work space and the
           array in which various computed values are returned.  The smallest
           acceptable dimension of IWORK is given below in the definition of
           subroutine argument LIWORK.

           Certain values returned in array IWORK are of general interest and
           can be accessed as described below in section X.  In particular, the
           results of the derivative checking procedure are encoded in IWORK,
           and may be useful if ODRPACK's error reports have been suppressed.


       31. LIWORK [INTEGER LIWORK]

           The length of array IWORK.  LIWORK must equal or exceed

           19 + 2*NP + M .

           Values of LIWORK less than this value will be treated as an input
           error.


       32. INFO [INTEGER INFO]

           The argument used to indicate why the computations stopped.

           If 1 <= INFO <= 3 then

              the program converged satisfactorily.  The convergence condition
              met is indicated by the value of INFO as follows.
              INFO = 1 :  sum of squares convergence
              INFO = 2 :  parameter convergence
              INFO = 3 :  sum of squares convergence and parameter convergence

           If INFO = 4 then

              the program reached the maximum number of iterations allowed
              without meeting one of the convergence conditions.

           If INFO > 4 and INFO < 10000 then

              the results from ODRPACK are questionable.  In this case, INFO is
              a 4 digit INTEGER with decimal expansion ABCD, where digit D
              indicates the actual stopping condition, and the nonzero values
              of digits A, B and C indicate what questionable conditions were
              found.

              Digit A = 1 indicates

                 the ODRPACK Jacobian matrix checking procedure determined that
                 the correctness of the user supplied Jacobian matrices is
                 questionable.  This occurs when the derivative is exactly zero
                 or when the numerical derivative used in the checking
                 procedure is believed to be inaccurate.  (Zero valued
                 derivatives are questionable because they could indicate that
                 the initial values of the function parameters BETA might be
                 hiding an error in the derivative, such as could occur if the
                 initial value of one of the parameters were zero.)  Users
                 should examine the ODRPACK error reports or the encoded values
                 of IWORK (see section X.B) to determine the cause of the
                 questionable results, and then examine subroutine JAC to
                 insure that there is not an error in the user supplied
                 derivatives that could be adversely affecting the least
                 squares results.

              Digit B = 1 indicates

                 the the most recently tried values of BETA and/or X+DELTA were
                 unacceptable, as indicated by the returned value of ISTOPF
                 from user supplied subroutine FUN (see argument FUN).

              Digit C > 0 indicates

                 the Jacobian with respect to the function parameters BETA is
                 not full rank at the solution.
                 If C=1 the rank is greater than zero but less than the number
                        of parameters being estimated.
                 If C=2 the rank is zero, indicating that the results of user
                        supplied subroutines FUN and/or JAC are unaffected by
                        changes in the unfixed function parameters (BETA), and
                        therefore indicating that there is a probable error in
                        these user supplied subroutines.

              Digit D > 0 indicates

                 the actual stopping condition.
                 If D=1 the sum of squares convergence criteria was met.
                 If D=2 the parameter convergence criteria was met.
                 If D=3 the sum of squares convergence criteria
                        and the parameter convergence criteria were met.
                 If D=4 the program reached the maximum number of iterations
                        allowed without meeting one of the convergence
                        conditions.

           If INFO > 9999 then

              fatal errors were detected that required that the computations be
              stopped.  In this case, INFO is a 5 digit INTEGER with decimal
              expansion ABCDE, where each nonzero digit indicates a different
              error condition.

              Digit A = 1 indicates an error was detected in the arguments used
                          to specify the problem size.

                 When digit A = 1 then

                    digit B = 1 indicates N < 1

                    digit C = 1 indicates M < 1

                    digit D = 1 indicates NP < 1 or NP > N

              Digit A = 2 indicates an error was detected in the arguments used
                          to specify array dimensions.

                 When digit A = 2 then

                    digit B = 1 indicates LDX < N

                    digit C > 0 indicates LDIFX, LDSCLD and/or LDWD are
                                unacceptable (see definitions of LDIFX, LDSCLD
                                and LDWD for acceptable values), where
                                if C=1 LDIFX is bad 
                                if C=2 LDSCLD is bad 
                                if C=3 LDIFX & LDSCLD are bad 
                                if C=4 LDWD is bad 
                                if C=5 LDIFX & LDWD are bad 
                                if C=6 LDSCLD & LDWD are bad 
                                if C=7 LDIFX, LDSCLD & LDWD are bad 

                    digit D = 1 indicates LWORK is too small (see definition of
                                LWORK for smallest acceptable value)

                    digit E = 1 indicates LIWORK is too small (see definition
                                of LIWORK for smallest acceptable value)

              Digit A = 3 indicates an error was detected in the arguments used
                          to specify scaling and/or the in the arguments used
                          to specify the weights.

                 When digit A = 3 then

                    digit B = 1 indicates an error in SCLD (see definition of
                                SCLD for reasonable values)

                    digit C = 1 indicates an error in SCLB (see definition of
                                SCLB for reasonable values)

                    digit D > 1 indicates an error in W, where
                                if D=1 one or more of the elements of W are
                                       invalid (see definition of W for
                                       reasonable values) 
                                if D=2 the number of nonzero values in W is
                                       less than NP 

                    digit E = 1 indicates an error in WD (see definition of WD
                                for reasonable values)

              Digit A = 4 indicates an error was detected in the user supplied
                          Jacobian matrices.

                 When digit A = 4 then

                    digit B = 1 indicates an error in the Jacobian matrix with
                                respect to BETA (see the generated error
                                reports, or section X.B for locations in IWORK
                                that indicate which derivatives are in error)

                    digit C = 1 indicates an error in the Jacobian matrix with
                                respect to X (see the generated error reports,
                                or section X.B for locations in IWORK that
                                indicate which derivatives are in error)

              Digit A = 5 indicates the values of BETA and/or X+DELTA were
                          identified as unacceptable by user supplied
                          subroutine FUN or JAC.

                 When digit A = 5 then

                    digit B > 0 indicates the computations were stopped in
                                user supplied subroutine FUN, where
                                if B=1 variable ISTOPF was returned with a
                                       negative value from subroutine FUN when
                                       it was invoked during the regression
                                       procedure, indicating that the user
                                       wanted the computations stopped 
                                if B=2 variable ISTOPF was returned with a
                                       nonzero value when subroutine FUN was
                                       invoked using the initial estimates of
                                       BETA and DELTA supplied by the user, so
                                       no further computations could be
                                       performed 
                                if B=3 variable ISTOPF was returned with a
                                       nonzero value when subroutine FUN was
                                       was invoked during the computation of
                                       the number of reliable digits in the
                                       predicted values (F) returned from
                                       subroutine FUN, indicating that
                                       changes in the initial estimates of
                                       BETA(K), K=1,NP, as small as
                                       2*BETA(K)*sqrt(e), where e is defined as
                                       the smallest value such that 1+e>1 on
                                       the computer being used, prevent
                                       subroutine FUN from being properly
                                       evaluated 
                                if B=4 variable ISTOPF was returned with a
                                       nonzero value when subroutine FUN was
                                       was invoked during the derivative
                                       checking procedure, indicating that
                                       changes in the initial estimates of
                                       BETA(K), K=1,NP, small as
                                       max[BETA(K),1/SCLB(K)]*10**(-NETA/2),
                                       and/or of DELTA(I,J), i=1,N and j=1,M,
                                       as small as max[DELTA(I,J),
                                       1/SCLD(I,J)]*10**(-NETA/2), where NETA
                                       is defined to be the number of reliable
                                       digits in predicted values (F) returned
                                       from subroutine FUN, prevent subroutine
                                       fun from being properly evaluated 

                    digit C > 0 indicates the computations were stopped in
                                user supplied subroutine JAC, where
                                if C=1 variable ISTOPJ was returned with a
                                       nonzero value from subroutine JAC when
                                       it was invoked during the regression
                                       procedure, indicating that the user
                                       wanted the computations stopped
                                if C=2 variable ISTOPJ was returned with a
                                       nonzero value from subroutine JAC when
                                       it was invoked using the initial
                                       estimates of BETA and DELTA supplied by
                                       the user, so no further computations
                                       could be performed




1   VIII.  EXAMPLES
           --------

    The following sample programs use DODR and DODRC to solve exercise I on
    page 521 and 522 of Draper and Smith [1981].  The program calling DODR uses
    the default option of computing the derivatives by finite differences,
    while the program calling DODRC uses analytic derivatives.  Note that the
    results of these two examples are not identical, primarily because the
    DODRC example has "fixed" one column of the independent variable.  Finite
    difference derivatives generally cause very little change in the results
    from those obtained using analytic derivatives.

    Users are encouraged to extract these examples from the online ODRPACK
    documentation, and to then modify them as necessary to form their own
    ODRPACK drivers.  (Single precision sample programs can be easily generated
    from these two programs by changing all DOUBLE PRECISION variables to REAL,
    and substituting SODR for DODR and SODRC for DODRC.)  Note especially that
    by using parameters MAXN, MAXM and MAXNP to specify the largest problem the
    program can solve without modification, and by specifying LWORK and LIWORK
    exactly as shown, the user greatly reduces the number of changes that must
    be made to the program in order to solve a larger problem.



1   VIII.A  DODR Example Program, Data and ODRPACK Generated Report

    User supplied code for DODR example:

          PROGRAM SAMPLE
    
    C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER
    C  WHERE  MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED 
    C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
    C              INDEPENDENT VARIABLE ALLOWED
    C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
    C              ALLOWED 
    C          LDX IS THE LEADING DIMENSION OF ARRAY X
    C         LDWD IS THE LEADING DIMENSION OF ARRAY WD
    C        LWORK IS THE DIMENSION OF VECTOR WORK
    C       LIWORK IS THE DIMENSION OF VECTOR IWORK
    
    C...PARAMETERS
          INTEGER
         +   MAXN,MAXM,MAXNP,LDX,LDWD,LWORK,LIWORK
          PARAMETER
         +   (MAXN=15,
         +   MAXM=5,
         +   MAXNP=5,
         +   LDX=MAXN,
         +   LDWD=1,
         +   LWORK = 17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
         +   LIWORK = 19 + 2*MAXNP + MAXM)
    
    C  DECLARE USER-SUPPLIED SUBROUTINES AND
    C  ALL OTHER NECESSARY VARIABLES AND ARRAYS
    
    C...LOCAL SCALARS
          INTEGER
         +   I,INFO,IPRINT,J,JOB,LUNERR,LUNRPT,M,N,NP
    
    C...LOCAL ARRAYS
          DOUBLE PRECISION
         +   BETA(MAXNP),WD(LDWD,MAXM),WORK(LWORK),
         +   X(LDX,MAXM),Y(LDX)
          INTEGER
         +   IWORK(LIWORK)
    
    C...EXTERNAL SUBROUTINES
          EXTERNAL
         +   DODR,FUN,JAC
    
    
          OPEN(UNIT=5,FILE='DATA1')
          OPEN(UNIT=6,FILE='REPORT')
    
    C  READ NUMBER OF OBSERVATIONS
    C       NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE
    C       NUMBER OF PARAMETERS
    C       OBSERVED VALUES OF INDEPENDENT AND DEPENDENT VARIABLES
    C       STARTING VALUES OF FUNCTION PARAMETERS
    
          READ (5,*) N,M,NP
          READ (5,*) ((X(I,J),I=1,N),J=1,M)
          READ (5,*) (Y(I),I=1,N)
          READ (5,*) (BETA(I),I=1,NP)
    
    C  SPECIFY DELTA WEIGHTS
    
          WD(1,1) = 3.0D0
          WD(1,2) = 5.0D0
    
    C  SET CONTROL VALUES TO INVOKE DEFAULT SETTING
    
          JOB = -1
          IPRINT = -1
          LUNERR = -1
          LUNRPT = -1
    
    C  COMPUTE ODR SOLUTION USING FINITE-DIFFERENCE DERIVATIVES
    
          CALL DODR
         +   (FUN,JAC,
         +   N,M,NP,
         +   X,LDX,
         +   Y,
         +   BETA,
         +   WD,LDWD,
         +   JOB,
         +   IPRINT,LUNERR,LUNRPT,
         +   WORK,LWORK,IWORK,LIWORK,
         +   INFO)
    
          END
          SUBROUTINE FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
    
    C  INPUT ARGUMENTS
    C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
    C     INTEGER N,NP,M,LDXPD
    C     DOUBLE PRECISION BETA(NP),XPLUSD(LDXPD,M)
    C  OUTPUT ARGUMENTS
    C     DOUBLE PRECISION F(N)
    C     INTEGER ISTOPF
    
    C...SCALAR ARGUMENTS
          INTEGER
         +   ISTOPF,LDXPD,M,N,NP
    
    C...ARRAY ARGUMENTS
          DOUBLE PRECISION
         +   BETA(NP),F(N),XPLUSD(LDXPD,M)
    
    C...LOCAL SCALARS
          INTEGER
         +   I
    
    C...INTRINSIC FUNCTIONS
          INTRINSIC
         +   EXP
    
    
          DO 10 I = 1, N
             IF (XPLUSD(I,2).NE.0.0D0) THEN
                F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
         +             EXP(-BETA(2)*
         +                  (1.0D0/XPLUSD(I,2) - 1.0D0/620.0D0)))
             ELSE
                ISTOPF = 1
                RETURN
             END IF
       10 CONTINUE
          ISTOPF = 0
    
          RETURN
          END


1   User supplied data (file DATA1):

        8    2    2
      109.0   65.0 1180.0   66.0
     1270.0   69.0 1230.0   68.0
      600.0  640.0  600.0  640.0
      600.0  640.0  600.0  640.0
      0.912  0.382  0.397  0.376
      0.342  0.358  0.348  0.376
    0.01155 5000.0


1   Report generated by DODR example program, using a Sun 3 Workstation:


   
   
   
    ******************************************************* 
    * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) * 
    ******************************************************* 
   
   
   
   
   
    INITIAL SUMMARY FOR FIT BY METHOD OF ODR
    ========================================
   
   
   
    PROBLEM SIZE:
    -------------
   
    NUMBER OF OBSERVATIONS                                8
    NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS           8
    NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     2
    NUMBER OF FUNCTION PARAMETERS                         2
    NUMBER OF UNFIXED FUNCTION PARAMETERS                 2
   
   
   
    INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:
    ----------------------------------------------
   
                                  COLUMN   1                COLUMN   2     
                              OBS 1        OBS N        OBS 1        OBS N
                  X -   0.10900D+03  0.68000D+02  0.60000D+03  0.64000D+03
              FIXED -            NO           NO           NO           NO
      INITIAL DELTA -   0.00000D+00  0.00000D+00  0.00000D+00  0.00000D+00
        DELTA SCALE -   0.91743D-02  0.14706D-01  0.15625D-02  0.15625D-02
      DELTA WEIGHTS -   0.30000D+01  0.30000D+01  0.50000D+01  0.50000D+01
   
   
   
    DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
    ----------------------------------------------------------
   
                              OBS 1        OBS N
                  Y -   0.91200D+00  0.37600D+00
    OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
   
   
   
    FUNCTION PARAMETER SUMMARY:
    ---------------------------
   
           INDEX -                1               2
    INITIAL BETA -   0.11550000D-01  0.50000000D+04
           FIXED -               NO              NO
      BETA SCALE -   0.86580087D+02  0.20000000D-03
   
   
   
    CONTROL VALUES AND STOPPING CRITERIA:
    --------------------------------------
   
          *                                     
       JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
     00000        15  0.10D+01  0.15D-07  0.37D-10     50
   
    *
     A.  FIT IS NOT A RESTART.
     B.  DELTAS ARE INITIALIZED TO ZERO.
     C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
         WILL BE COMPUTED AT THE SOLUTION.
     D.  DERIVATIVES ARE COMPUTED BY FINITE DIFFERENCES.
     E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.
   
   
   
    INITIAL SUMS OF SQUARES:
    ------------------------
   
    SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.67662011D+00
    SUM OF SQUARED WEIGHTED DELTAS                  0.00000000D+00
    SUM OF SQUARED WEIGHTED EPSILONS                0.67662011D+00
   
   
   
   
   
   
   
    FINAL SUMMARY FOR FIT BY METHOD OF ODR
    ======================================
   
   
   
    STOPPING CONDITION (INFO =      1):
    -----------------------------------
   
    THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
    WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
   
                                CONDITION            
          NUMBER OF  NUMBER OF     NUMBER        RANK
         ITERATIONS   FN EVALS  (INVERSE)  DEFICIENCY
                  5         42 0.1888D-06           0
   
   
   
    FINAL SUMS OF SQUARES:
    ----------------------
   
    SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.75382323D-03
    SUM OF SQUARED WEIGHTED DELTAS                  0.23542098D-07
    SUM OF SQUARED WEIGHTED EPSILONS                0.75379969D-03
   
    ESTIMATED RESIDUAL VARIANCE                     0.12563720D-03
    (    6 DEGREES OF FREEDOM)
   
   
   
    ESTIMATED BETA(J), J = 1, ..., NP:
    ----------------------------------
   
                J          BETA(J)     STD. DEV. BETA(J)
                1   0.36579727D-02        0.42219552D-04
                2   0.27627327D+05        0.22245631D+03
   
   
   
    ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
    ---------------------------------------------------
   
        I      EPSILON(I)      DELTA(I,1)      DELTA(I,2)
        1  0.16752445D-02  0.14086172D-06  0.42418826D-06
        2  0.20434718D-02  0.12838222D-05  0.20262810D-05
        3 -0.20690085D-01 -0.71652290D-06 -0.23358824D-04
        4  0.24305832D-02  0.15047092D-05  0.24114481D-05
        5  0.72777482D-02  0.23393281D-06  0.82079307D-05
        6  0.40793264D-02  0.24162846D-05  0.40483550D-05
        7  0.13043071D-01  0.43337343D-06  0.14726726D-04
        8 -0.85499649D-02 -0.51394679D-05 -0.84861061D-05



1   VIII.B  DODRC Example Program, Data and ODRPACK Generated Report

    User supplied code for DODRC example:

          PROGRAM SAMPLE
    
    C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER
    C  WHERE  MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED 
    C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
    C              INDEPENDENT VARIABLE ALLOWED
    C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
    C              ALLOWED 
    C          LDX IS THE LEADING DIMENSION OF ARRAY X
    C       LDSCLD IS THE LEADING DIMENSION OF ARRAY SCLD
    C         LDWD IS THE LEADING DIMENSION OF ARRAY WD
    C        LDIFX IS THE LEADING DIMENSION OF ARRAY IFIXX
    C        LWORK IS THE DIMENSION OF VECTOR WORK
    C       LIWORK IS THE DIMENSION OF VECTOR IWORK
    
    C...PARAMETERS
          INTEGER
         +   MAXN,MAXM,MAXNP,LDSCLD,LDIFX,LDWD,LWORK,LIWORK
          PARAMETER
         +   (MAXN=15,
         +   MAXM=5,
         +   MAXNP=5,
         +   LDSCLD=1,
         +   LDWD=1,
         +   LDIFX=1,
         +   LWORK=17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
         +   LIWORK=19 + 2*MAXNP + MAXM)
    
    C  DECLARE USER-SUPPLIED SUBROUTINES AND
    C  ALL OTHER NECESSARY VARIABLES AND ARRAYS
    
    C...LOCAL SCALARS
          DOUBLE PRECISION
         +   PARTOL,SSTOL,TAUFAC
          INTEGER
         +   I,INFO,IPRINT,J,JOB,LDX,LUNERR,LUNRPT,M,MAXIT,N,NDIGIT,NP
    
    C...LOCAL ARRAYS
          DOUBLE PRECISION
         +   BETA(MAXNP),WD(LDWD,MAXM),SCLB(MAXNP),
         +   SCLD(LDSCLD,MAXM),W(MAXN),WORK(LWORK),X(MAXN,MAXM),Y(MAXN)
          INTEGER
         +   IFIXB(MAXNP),IFIXX(LDIFX,MAXM),IWORK(LIWORK)
    
    C...EXTERNAL SUBROUTINES
          EXTERNAL
         +   DODRC,FUN,JAC
    
    
          OPEN(UNIT=5,FILE='DATA1')
          OPEN(UNIT=6,FILE='REPORT')
    
    C  SPECIFY LEADING DIMENSION OF ARRAY X
    
          LDX = MAXN
    
    C  READ NUMBER OF OBSERVATIONS
    C       NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE
    C       NUMBER OF PARAMETERS
    C       OBSERVED VALUES OF INDEPENDENT AND DEPENDENT VARIABLES
    C       STARTING VALUES OF FUNCTION PARAMETERS
    
          READ (5,*) N,M,NP
          READ (5,*) ((X(I,J),I=1,N),J=1,M)
          READ (5,*) (Y(I),I=1,N)
          READ (5,*) (BETA(I),I=1,NP)
    
    C  FIX SECOND COLUMN OF INDEPENDENT VARIABLE AT OBSERVED VALUES
    
          IFIXX(1,1) = 1
          IFIXX(1,2) = 0
    
    C  SPECIFY USE OF DEFAULT SCALING
    
          SCLD(1,1) = -1.0D0
          SCLB(1) = -1.0D0
    
    C  INDICATE ALL BETA'S ARE TO BE ESTIMATED
    
          IFIXB(1) = -1
    
    C  SPECIFY WEIGHTS
    
          WD(1,1) = 3.0D0
          WD(1,2) = 5.0D0
          W(1) = -1.0D0
    
    C  SET CONTROL VALUES AND STOPPING CRITERIA
    
          JOB = 10
          NDIGIT = -1
          TAUFAC = -1.0D0
          SSTOL = -1.0D0
          PARTOL = -1.0D0
          MAXIT = -1
          IPRINT = 1111
          LUNERR = -1
          LUNRPT = -1
    
    C  COMPUTE ODR SOLUTION USING USER-SUPPLIED ANALYTIC DERIVATIVES
    
          CALL DODRC
         +   (FUN,JAC,
         +   N,M,NP,
         +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
         +   Y,
         +   BETA,IFIXB,SCLB,
         +   WD,LDWD,W,
         +   JOB,NDIGIT,TAUFAC,
         +   SSTOL,PARTOL,MAXIT,
         +   IPRINT,LUNERR,LUNRPT,
         +   WORK,LWORK,IWORK,LIWORK,
         +   INFO)
    
          END
          SUBROUTINE FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
    
    C  INPUT ARGUMENTS
    C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
    
    C     INTEGER N,NP,M,LDXPD
    C     DOUBLE PRECISION BETA(NP),XPLUSD(LDXPD,M)
    
    C  OUTPUT ARGUMENTS
    
    C     DOUBLE PRECISION F(N)
    C     INTEGER ISTOPF
    
    C...SCALAR ARGUMENTS
          INTEGER
         +   ISTOPF,LDXPD,M,N,NP
    
    C...ARRAY ARGUMENTS
          DOUBLE PRECISION
         +    BETA(NP),F(N),XPLUSD(LDXPD,M)
    
    C...LOCAL SCALARS
          INTEGER
         +    I
    
    C...INTRINSIC FUNCTIONS
          INTRINSIC
         +    EXP
    
    
          DO 10 I = 1, N
             IF (XPLUSD(I,2).NE.0.0D0) THEN
                F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
         +             EXP(-BETA(2)*
         +                  (1.0D0/XPLUSD(I,2) - 1.0D0/620.0D0)))
             ELSE
                ISTOPF = 1
                RETURN
             END IF
       10 CONTINUE
          ISTOPF = 0
    
          RETURN
          END
          SUBROUTINE JAC(N,NP,M,BETA,XPLUSD,LDXPD,
         +               FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOPJ)
    
    C  INPUT ARGUMENTS
    C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
    
    C     INTEGER N,NP,M,LDXPD
    C     DOUBLE PRECISION BETA(NP),XPLUSD(LDXPD,M)
    C     LOGICAL ISODR
    
    C  OUTPUT ARGUMENTS
    
    C     DOUBLE PRECISION FJACB(LDFJB,NP),FJACX(LDFJX,M)
    C     INTEGER ISTOPJ
    
    C...SCALAR ARGUMENTS
          INTEGER
         +   ISTOPJ,LDFJB,LDFJX,LDXPD,M,N,NP
          LOGICAL
         +   ISODR
    
    C...ARRAY ARGUMENTS
          DOUBLE PRECISION
         +   BETA(NP),FJACB(LDFJB,NP),FJACX(LDFJX,M),XPLUSD(LDXPD,M)
    
    C...LOCAL SCALARS
          DOUBLE PRECISION
         +   FAC1,FAC2,FAC3,FAC4
          INTEGER
         +   I
    
    C...INTRINSIC FUNCTIONS
          INTRINSIC
         +   EXP
    
    
          DO 10 I=1,N
             FAC1 = 1.0D0/XPLUSD(I,2) - 1.0D0/620.0D0
             FAC2 = EXP(-BETA(2)*FAC1)
             FAC3 = BETA(1)*XPLUSD(I,1)
             FAC4 = EXP(-FAC3*FAC2)
    
             FJACB(I,1) = -FAC4*XPLUSD(I,1)*FAC2
             FJACB(I,2) = FAC4*FAC3*FAC2*FAC1
    
             IF (ISODR) THEN
                FJACX(I,1) = -FAC4*BETA(1)*FAC2
                FJACX(I,2) = -FAC4*FAC3*FAC2*BETA(2)/XPLUSD(I,2)**2
             END IF
       10 CONTINUE
          ISTOPJ = 0
    
          RETURN
          END


1   User supplied data (file DATA1):

        8    2    2
      109.0   65.0 1180.0   66.0
     1270.0   69.0 1230.0   68.0
      600.0  640.0  600.0  640.0
      600.0  640.0  600.0  640.0
      0.912  0.382  0.397  0.376
      0.342  0.358  0.348  0.376
    0.01155 5000.0


1   Report generated by DODRC example program, using a Sun 3 Workstation:


   
   
   
    ******************************************************* 
    * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) * 
    ******************************************************* 
   
   
   
   
   
    INITIAL SUMMARY FOR FIT BY METHOD OF ODR
    ========================================
   
   
   
    PROBLEM SIZE:
    -------------
   
    NUMBER OF OBSERVATIONS                                8
    NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS           8
    NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     2
    NUMBER OF FUNCTION PARAMETERS                         2
    NUMBER OF UNFIXED FUNCTION PARAMETERS                 2
   
   
   
    CONTROL VALUES AND STOPPING CRITERIA:
    --------------------------------------
   
          *                                     
       JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
     00010        15  0.10D+01  0.15D-07  0.37D-10     50
   
    *
     A.  FIT IS NOT A RESTART.
     B.  DELTAS ARE INITIALIZED TO ZERO.
     C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
         WILL BE COMPUTED AT THE SOLUTION.
     D.  DERIVATIVES ARE SUPPLIED BY USER.
         USER-SUPPLIED DERIVATIVES WERE CHECKED.
         THE DERIVATIVES APPEAR TO BE CORRECT.
     E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.
   
   
   
    INITIAL SUMS OF SQUARES:
    ------------------------
   
    SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.67662011D+00
    SUM OF SQUARED WEIGHTED DELTAS                  0.00000000D+00
    SUM OF SQUARED WEIGHTED EPSILONS                0.67662011D+00
   
   
   
   
   
    ITERATION REPORTS FOR FIT BY METHOD OF ODR
    ==========================================
   
   
            CUM.                 ACT. REL.   PRED. REL.
     IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
    NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
    ----  ------  -----------  -----------  -----------  ---------  ----
   
       1      12  0.19694D+00   0.7089D+00   0.4162D+00  0.151D+01   YES
       2      13  0.18660D-02   0.9905D+00   0.9957D+00  0.671D+00   YES
       3      14  0.75385D-03   0.5960D+00   0.5961D+00  0.463D-01   YES
       4      15  0.75385D-03   0.3659D-06   0.3659D-06  0.224D-04   YES
       5      16  0.75385D-03   0.3715D-13   0.3892D-13  0.482D-08   YES
   
   
   
   
   
   
   
    FINAL SUMMARY FOR FIT BY METHOD OF ODR
    ======================================
   
   
   
    STOPPING CONDITION (INFO =      1):
    -----------------------------------
   
    THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
    WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
   
                                          CONDITION            
          NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
         ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
                  5         17          7 0.1888D-06           0
   
   
   
    FINAL SUMS OF SQUARES:
    ----------------------
   
    SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.75384644D-03
    SUM OF SQUARED WEIGHTED DELTAS                  0.33248273D-09
    SUM OF SQUARED WEIGHTED EPSILONS                0.75384611D-03
   
    ESTIMATED RESIDUAL VARIANCE                     0.12564107D-03
    (    6 DEGREES OF FREEDOM)
   
   
   
    ESTIMATED BETA(J), J = 1, ..., NP:
    ----------------------------------
   
                J          BETA(J)     STD. DEV. BETA(J)
                1   0.36579727D-02        0.42219603D-04
                2   0.27627326D+05        0.22245657D+03
   
   
   
    ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
    ---------------------------------------------------
   
        I      EPSILON(I)      DELTA(I,1)      DELTA(I,2)
        1  0.16752465D-02  0.14086188D-06  0.00000000D+00
        2  0.20435276D-02  0.12838572D-05  0.00000000D+00
        3 -0.20690747D-01 -0.71654588D-06  0.00000000D+00
        4  0.24306485D-02  0.15047496D-05  0.00000000D+00
        5  0.72779764D-02  0.23394016D-06  0.00000000D+00
        6  0.40794324D-02  0.24163474D-05  0.00000000D+00
        7  0.13043483D-01  0.43338715D-06  0.00000000D+00
        8 -0.85501699D-02 -0.51395912D-05  0.00000000D+00



1   IX.  SCALING ALGORITHMS
         ------------------

    Poorly scaled problems, i.e., problems in which the unknowns BETA and DELTA
    vary over several orders of magnitude, can cause least squares procedures
    difficulty.  ODRPACK's scaling algorithms (discussed below) attempt to
    overcome these difficulties automatically, although it is preferable for
    the user to choose the units of the variable space so that the estimated
    parameters will have roughly the same magnitude [Dennis and Schnabel,
    1983].  When the variables have roughly the same magnitude, the ODRPACK
    scaling algorithm will select scale values that are roughly equal, and the
    resulting computations will be the same (except for the effect of finite
    precision arithmetic) as an unscaled analysis, i.e., an analysis in which
    all of the scale values are set to one.  If the user does not do this, the
    ODRPACK scaling algorithm will select varying scale values.  This will not
    change the optimal solution, but it may affect the number of iterations
    required, or, in some cases, whether the algorithm is or is not
    successful.

    Users may substitute their own scaling values using subroutine arguments
    SCLD and SCLB (see section VII.B).



1   IX.A  BETA Scaling

    ODRPACK chooses the scale values for the estimated BETAs as follows.

    If some of the starting values of BETA are nonzero then
       let BETA_max = the largest absolute value of the nonzero starting values
                      of BETA, and
           BETA_min = the smallest absolute value of the nonzero starting
                      values of BETA.

       For K = 1 to NP do
          if BETA(K) = zero then
             scale_BETA(K) = ten/BETA_min
          else
             if LOG10(BETA_max)-LOG10(BETA_min) > one then
                scale_BETA(K) = one/ABS(BETA(K))
             else
                scale_BETA(K) = one/BETA_max.

    If all of the starting values of BETA are zero then
       for K = 1 to NP do
           scale_BETA(K) = one.

    Users may substitute their own BETA scaling values via subroutine argument
    SCLB.



1   IX.B  DELTA Scaling

    ODRPACK chooses scale values for the estimated errors in the independent
    variables, i.e., for the DELTAs, as follows.

    For J = 1 to M do

       If some of the values of the Jth column of X are nonzero then
          let  X_max = the largest nonzero absolute value in the Jth column of
                       array X, and
               X_min = the smallest nonzero absolute value in the Jth column
                       of array X.

          For I = 1 to N do
             if X(I,J) = zero then
                scale_X(I,J) = ten/X_min
             else
                if LOG10(X_max)-LOG10(X_min) > one then
                   scale_X(I,J) = one/ABS(X(I,J))
                else
                   scale_X(I,J) = one/X_max.

       If all of the values of the Jth column of X are zero then
          For I = 1 to N do
                scale_X(I,J) = one

    Users may substitute their own DELTA scaling values via subroutine argument
    SCLD.



1   X.   EXTRACTING INFORMATION FROM THE WORK VECTORS
         --------------------------------------------

    X.A  Extracting Information from Vector WORK

    Upon return from a call to ODRPACK, array WORK contains various values,
    some of which may be of interest to the user.

    To extract information from WORK, the following declaration statement must
    be added to the user's program:

       INTEGER
      +   DELTAI,EPSI,
      +   WSSI,WSSDEI,WSSEPI,RVARI,
      +   PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
      +   FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
      +   DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
      +   ALPHAI,VCVI,OMEGAI,YTI,UI,QRAUXI,WRK1I,SDI,RCONDI,
      +   ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
      +   LWKMN 

    where DELTAI through RNORSI are variables that indicate the starting
    locations within WORK of the stored values, and LWKMN is the minimum
    acceptable length of array WORK. 

    The appropriate values of DELTAI through RNORSI are obtained by invoking
    subroutine SWINF when using either of the single precision ODRPACK
    subroutines, SODR or SODRC, and by invoking DWINF when using either of the
    double precision subroutines, DODR or DODRC.  The call statements for SWINF
    and DWINF have the same argument lists.  To invoke either subroutine, use

       CALL <winf>
      +   (N,M,NP,
      +   DELTAI,EPSI,
      +   WSSI,WSSDEI,WSSEPI,RVARI,
      +   PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
      +   FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
      +   DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
      +   ALPHAI,VCVI,OMEGAI,YTI,UI,QRAUXI,WRK1I,SEI,RCONDI,
      +   ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
      +   LWKMN)

    where SWINF should be substituted for <winf> when using single precision
    subroutines SODR and SODRC, and DWINF should be substituted for <winf> when
    using double precision subroutines DODR and DODRC.  The values of N, M and
    NP must be input to SIWINF and DIWINF with exactly the same values as were
    used in the original call to ODRPACK.  (If possible, users should extract
    these declaration and call statements from online ODRPACK documentation to
    avoid typographical errors.)

    In the following descriptions of the information returned in WORK, (*)
    indicates values that are likely to be of greatest interest.

    (*) WORK(DELTAI)  is the first element of the N by M matrix, DELTA,
                      containing the estimated errors in the independent
                      variables at the solution,

                      DELTA(I,J) = WORK(DELTAI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

    (*) WORK(EPSI)    is the first element of the N vector, EPSILON, containing
                      the estimated errors in the dependent variables at the
                      solution,

                      EPSILON(I) = WORK(EPSI-1+I)

                      for I=1,...,N.

    (*) WORK(WSSI)    is the weighted sum of the squared observation errors
                      (eq.3) at the time the computations stopped, i.e.,

                      WORK(WSSI) = WORK(WSSDEI) + WORK(WSSEPI) 

                      where WORK(WSSDEI) and WORK(WSSEPI) are defined below.

    (*) WORK(WSSDEI)  is the weighted sum of the squared DELTAs at the time the
                      computations stopped, i.e.,

                                      N     M
                      WORK(WSSDEI) = SUM [ SUM ( W(I)*D(I,J)*DELTA(I,J) )**2 ] .
                                     I=1   J=1

    (*) WORK(WSSEPI)  is the weighted sum of the squared EPSILONs at the time
                      the computations stopped, i.e.,

                                      N     
                      WORK(WSSEPI) = SUM [ ( W(I)*EPSILON(I) )**2 ] .
                                     I=1   

    (*) WORK(RVARI)   is the estimated residual variance at the time the
                      computations stopped, i.e.,

                                     N     
                                    SUM [ ( W(I)*R(I) )**2 ]  
                                    I=1   
                      WORK(RVARI) = ------------------------  
                                               DF

                      where DF is the degrees of freedom of the fit, i.e., the
                      number of observations with nonzero weighted derivatives
                      with respect to either BETA or DELTA minus the number of
                      parameters being estimated.

        WORK(PARTLI)  is the value of the stopping tolerance used to detect
                      parameter convergence.

        WORK(SSTOLI)  is the value of the stopping tolerance used to detect
                      sum of squares convergence.

        WORK(TAUFCI)  is the value of the factor used to compute the initial
                      trust region radius.

        WORK(EPSMAI)  is the value of machine precision, i.e., the smallest
                      value e such that 1+e>1.

        WORK(OLMAVI)  is the average number of steps to obtain the Levenberg-
                      Marquardt parameter.

        WORK(FJACBI)  is the first element of the N by NPP matrix, FJACB,
                      containing the weighted derivative with respect to BETA,
                      evaluated at the solution if the covariance matrix was
                      computed, otherwise evaluated at the beginning of the last
                      iteration,

                      FJACB(I,J) = WORK(FJACBI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,NP.

        WORK(FJACXI)  is the first element of the N by M matrix, FJACX,
                      containing the weighted derivative with respect to X,
                      evaluated at the solution if the covariance matrix was
                      computed, otherwise evaluated at the beginning of the last
                      iteration,

                      FJACX(I,J) = WORK(FJACXI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

    (*) WORK(XPLUSI)  is the first element of the N by M matrix containing the
                      final estimates of X, i.e.,
                      estimated< X > = observed< X > + estimated< DELTA >
                      computed using the final estimates of DELTA,

                      XPLUSD(I,J) = WORK(XPLUSI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

        WORK(BETACI)  is the first element of the NP vector, BETAC, containing
                      the current working estimates of the unfixed subset of
                      the  function parameters,

                      BETAC(I) = WORK(BETACI-1+I)

                      for I=1,...,NP.

        WORK(BETASI)  is the first element of the NP vector, BETAS, containing
                      the previous working estimates of the unfixed subset of
                      the function parameters,

                      BETAS(I) = WORK(BETASI-1+I)

                      for I=1,...,NP.

        WORK(BETANI)  is the first element of the NP vector, BETAN, containing
                      the new working estimates of the unfixed subset of the
                      function parameters,

                      BETAN(I) = WORK(BETANI-1+I)

                      for I=1,...,NP.

        WORK(DELTSI)  is the first element of the N by M matrix, DELTAS,
                      containing the previous working estimates of the errors
                      in the independent variables,

                      DELTAS(I,J) = WORK(DELTASI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

        WORK(DELTNI)  is the first element of the N by M matrix, DELTAN,
                      containing the new working estimates of the errors in the
                      independent variables,

                      DELTAN(I,J) = WORK(DELTANI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

        WORK(DDELTI)  is the first element of the N by M matrix
                      containing the weighted estimated errors in the
                      independent variables, DDELTA = (W*D)**2 * DELTA,

                      DDELTA(I,J) = WORK(DDELTI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

        WORK(FSI)     is the first element of the N vector, FS, containing the
                      saved weighted estimated errors in the dependent
                      variable,

                      FS(I) = WORK(FSI-1+I)

                      for I=1,...,N.

    (*) WORK(FNI)     is the first element of the N vector, FN, containing the
                      final estimates of Y = FN(X+DELTA;BETA), i.e.,
                      estimated< Y > = observed< Y > + estimated< EPSILON >
                      computed using the final estimates of EPSILON,

                      FN(I) = WORK(FNI-1+I)

                      for I=1,...,N.

        WORK(SI)      is the first element of the NP vector, S, containing the
                      step in the estimated function parameters,

                      S(I) = WORK(SI-1+I)

                      for I=1,...,NP.

    (*) WORK(SSSI)    is the first element of the N + N*M vector, SSS,
                      containing the weighted errors at the solution,

                      SSS(I) = WORK(SSSI-1+I)

                      for I=1,...,N + N*M, where the first N elements contain
                      the weighted EPSILONs,

                      W(I)*EPSILON(I) = WORK(SSSI-1+I) 

                      for I=1,...,N and the next N*M elements contain the 
                      weighted DELTAs,

                      W(I)*D(I,J)*DELTA(I,J) = WORK(SSSI-1+I+J*N)

                      for I=1,...,N & J=1,...,M.

        WORK(SSI)     is the first element of the NP vector, SS, containing the
                      scale of the estimated function parameters,

                      SS(I) = WORK(SSI-1+I)

                      for I=1,...,NP.

        WORK(SSFI)    is the first element of the NP vector, SSF, containing
                      the scale of each of the function parameters,

                      SSF(I) = WORK(SSFI-1+I)

                      for I=1,...,NP.

        WORK(TI)      is the first element of the N by M array, T, containing
                      the step in the estimated errors in the independent
                      variable,

                      T(I,J) = WORK(TI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

        WORK(TTI)     is the first element of the N by M array, TT, containing
                      the scale of each the estimated errors in the independent
                      variable,

                      TT(I,J) = WORK(TTI-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

        WORK(TAUI)    is the trust region radius at the time the computations
                      stopped.

        WORK(ALPHAI)  is the Levenberg-Marquardt parameter at the time the
                      computations stopped.

    (*) WORK(VCVI)    is the first element of the covariance matrix of the NPP
                      unfixed parameters, stored as an upper triangular matrix,

                      VCV(I,J) = WORK(VCVI-1+I+(J-1)*N)
                      VCV(J,I) = VCV(I,J)

                      for I=1,...,NPP & J=I,...,NPP.  The covariance matrix is
                      only computed when the third digit of JOB is zero, and
                      when the solution is full rank.

                      The covariance matrix is defined as

                      VCV = RVAR * inv( trans(FJACB)*OMEGA*FJACB )

                      where

                      RVAR     is the residual variance of the fit,

                                      1     N
                               RVAR = -- * SUM (W(I)*R(I))**2 
                                      DF   I=1

                               with DF the number of observations with nonzero
                               weighted derivatives with respect to either BETA
                               or DELTA minus the number of parameters actually
                               estimated,

                      FJACB    is the derivative of FN(X(I,J)+DELTA(I,J);BETA)
                               with respect to BETA, evalutated at the
                               solution,

                      OMEGA    is the diagonal matrix which has (I,I)th element

                                                   W(I)**2
                               OMEGA(I,I) = ---------------------
                                                 M  FJACX(I,J)**2
                                            1 + SUM -------------
                                                J=1   D(I,J)**2

                               with FJACX(I,J) the derivative of
                               FN(X(I,J)+DELTA(I,J);BETA) with respect to
                               DELTA(I,J), evalutated at the solution (for
                               ordinary least squares, OMEGA(I,I) reduces to
                               W(I)**2),

                      inv(.)   indicates the inverse of the designated matrix,
                               and

                      trans(.) indicates the transpose of the designated
                               matrix.

                      Note that the covariance matrix is an approximation based
                      on a linearization of the model in the neighborhood of
                      the solution.  The validity of the approximation depends
                      on the nonlinearity of the model, the variance and
                      distribution of the errors, and the data itself.
                      Confidence regions and intervals computed using the
                      variance covariance matrix are often acceptable, but can
                      be very inaccurate in some cases.  When reliable
                      confidence intervals and regions are required, other more
                      accurate, but more computationally expensive methods of
                      constructing them should be used.  (See, e.g., Boggs and
                      Donaldson [1989], Donaldson and Schnabel [1987], Efron
                      [1985], and Fuller [1987].)

        WORK(OMEGAI)  is the first element of the N vector

                      OMEGA(I) = WORK(OMEGAI-1+I)

                                        W(I)**2
                               = ---------------------
                                      M  FJACX(I,J)**2
                                 1 + SUM -------------
                                     J=1   D(I,J)**2

                      for I=1,...,N, computed at the solution if the covariance
                      matrix was calculated.

        WORK(YTI)     is the first element of the N vector containing the
                      diagonal elements of

                      YT(I) = WORK(YTI-1+I)

                            = -diag[sqrt(OMEGA(I),I=1,...,N]*(G1-V*inv(E)*D*G2)

                      for I=1,...,N.

        WORK(UI)      is the first element of the N vector, U, containing the
                      approximate null vector for FJACB,

                      U(I) = WORK(UI-1+I)

                      for I=1,...,N.

        WORK(QRAUXI)  is the first element of the NP vector, QRAUX, required to
                      recover the QR decomposition of FJACB,

                      QRAUX(I) = WORK(QRAUXI-1+I)

                      for I=1,...,NP.

        WORK(WRK1I)   is the first element of the N by M matrix, WRK1, required
                      for work space,

                      WRK1(I,J) = WORK(WRK1I-1+I+(J-1)*N)

                      for I=1,...,N & J=1,...,M.

    (*) WORK(SEI)     is the first element of the NP vector containing the
                      standard errors of the function parameters BETA, i.e.,
                      the square roots of the diagonal entries of the
                      covariance matrix stored in WORK(VCVI) for the unfixed
                      parameters and zero for the fixed parameters,

                      SE(I) = WORK(SEI-1+I)

                      for I=1,...,NP.  The standard errors are only computed
                      when the third digit of JOB is zero, and when the solution
                      is full rank.

                      Note that the covariance matrix used to compute the
                      standard errors is an approximation based on a
                      linearization of the model in the neighborhood of the
                      solution.  The validity of the approximation depends on
                      the nonlinearity of the model, the variance and
                      distribution of the errors, and the data itself.
                      Confidence intervals computed using the covariance matrix
                      are often acceptable, but can be very inaccurate in some
                      cases.  When reliable confidence intervals and regions
                      are required, other more accurate, but more
                      computationally expensive methods of constructing them
                      should be used.  (See, e.g., Boggs and Donaldson [1989],
                      Donaldson and Schnabel [1987], Efron [1985], and Fuller
                      [1987].)

    (*) WORK(RCONDI)  is the reciprocal of the condition number at the time the
                      computations stopped.

    (*) WORK(ETAI)    is the value of the relative error in the model function
                      value.

        WORK(ACTRSI)  is the saved actual relative reduction in the weighted
                      sum of squares of the observation errors from the last
                      iteration.

        WORK(PNROMI)  is the norm of the scaled estimated parameters from the
                      last iteration.

        WORK(PRERSI)  is the saved predicted relative reduction in the weighted
                      sum of the squares of the observation errors from the
                      last iteration.

        WORK(RNORSI)  is the norm of the saved weighted observation errors from
                      the last iteration.



1   X.B  Extracting Information from Vector IWORK

    Upon return from a call to ODRPACK, array IWORK contains various values,
    some of which may be of interest to the user.

    To extract information from IWORK, the following declaration statement must
    be added to the user's program

       INTEGER
      +   MSGB,MSGX,JPVTI,
      +   NNZWI,NPPI,IDFI,
      +   JOBI,IPRINI,LUNERI,LUNRPI,
      +   NROWI,NTOLI,NETAI,
      +   MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
      +   LIWKMN 

    where MSGB through LDTTI are variables that indicate the starting locations
    within IWORK of the stored values, and LIWKMN is the minimum acceptable
    length of array IWORK.  The appropriate values of MSGB through LDTTI are
    obtained by invoking subroutine SIWINF when using either of the single
    precision ODRPACK subroutines, SODR or SODRC, and by invoking DIWINF when
    using either of the double precision subroutines, DODR or DODRC.  The call
    statements for SIWINF and DIWINF have the same argument lists.  To invoke
    either subroutine, use

       CALL <iwinf>
      +   (M,NP,
      +   MSGB,MSGX,JPVTI,
      +   NNZWI,NPPI,IDFI,
      +   JOBI,IPRINI,LUNERI,LUNRPI,
      +   NROWI,NTOLI,NETAI,
      +   MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
      +   LIWKMN)

    where SIWINF should be substituted for <iwinf> when using single precision
    subroutines SODR and SODRC, and DIWINF should be substituted for <iwinf>
    when using double precision subroutines DODR and DODRC.  Note that the
    values of M and NP must be input to SIWINF and DIWINF with exactly the same
    values as were used in the original call to ODRPACK.  (If possible, users
    should extract these declaration and call statements from online ODRPACK
    documentation to avoid typographical errors.)

    In the following descriptions of the information returned in IWORK, (*)
    indicates values that are likely to be of greatest interest.

    (*) IWORK(MSGB)   is the first element of the NP+1 vector, MSGB, used to
                      indicate the results of checking the partial derivatives
                      with respect to BETA.

                      The value of IWORK(MSGB) summarizes the results over all
                      of the BETAs.

                      If IWORK(MSGB) < 0, the partial derivatives with respect
                                          to each of the BETAs were not
                                          checked.

                      If IWORK(MSGB) = 0, the partial derivatives with respect
                                          to each of the BETAs appear to be
                                          correct.

                      If IWORK(MSGB) = 1, the partial derivative with respect
                                          to at least one of the BETAs appears
                                          to be incorrect.

                      If IWORK(MSGB) = 2, the partial derivative with respect
                                          to at least one of the BETAs is
                                          questionable.

                      The value of IWORK(MSGB+K), K=1,...,NP, indicates the
                      individual results for the partial derivative with
                      respect to BETA(K), K=1,...,NP.

                      If IWORK(MSGB+K) = 0, the partial derivative with respect
                                            to BETA(K) appears to be correct.

                      If IWORK(MSGB+K) = 1, the partial derivative with respect
                                            to BETA(K) appears to be incorrect,
                                            i.e., the user supplied derivative
                                            and the finite difference value it
                                            is checked against do not agree to
                                            within the required tolerance and
                                            there is no reason to question the
                                            results.

                      If IWORK(MSGB+K) = 2, the partial derivative with respect
                                            to BETA(K) appears to be
                                            questionable because the
                                            user supplied derivative and the
                                            finite difference value it is
                                            checked against are both zero.

                      If IWORK(MSGB+K) = 3, the partial derivative with respect
                                            to BETA(K) appears to be
                                            questionable because the
                                            user supplied derivative is exactly
                                            zero and the finite difference
                                            value it is checked against is only
                                            approximately zero.

                      If IWORK(MSGB+K) = 4, the partial derivative with respect
                                            to BETA(K) appears to be
                                            questionable because the
                                            user supplied derivative is exactly
                                            zero and the finite difference
                                            value it is checked against is not
                                            even approximately zero.

                      If IWORK(MSGB+K) = 5, the partial derivative with respect
                                            to BETA(K) appears to be
                                            questionable because the finite
                                            difference value it is being
                                            checked against is questionable due
                                            to a high ratio of relative
                                            curvature to relative slope or to
                                            an incorrect scale value.

                      If IWORK(MSGB+K) = 6, the partial derivative with respect
                                            to BETA(K) appears to be
                                            questionable because the finite
                                            difference value it is being
                                            checked against is questionable due
                                            to a high ratio of relative
                                            curvature to relative slope.

    (*) IWORK(MSGX)   is the first element of the M+1 vector, MSGX, used to
                      indicate the results of checking the partial derivatives
                      with respect to X.

                      The value of IWORK(MSGX) summarizes the results over all
                      of the Xs.

                      If IWORK(MSGX) < 0, the partial derivatives with respect
                                          to each of the Xs were not checked.

                      If IWORK(MSGX) = 0, the partial derivatives with respect
                                          to each of the Xs appear to be
                                          correct.

                      If IWORK(MSGX) = 1, the partial derivative with respect
                                          to at least one of the Xs appears to
                                          be incorrect.

                      If IWORK(MSGX) = 2, the partial derivative with respect
                                          to at least one of the Xs is
                                          questionable.

                      The value of IWORK(MSGX+J), J=1,...,M, indicates the
                      individual results for the partial derivative with
                      respect to the Jth column of X, J=1,...,M.

                      If IWORK(MSGX+J) = 0, the partial derivative with respect
                                            to the Jth column of X appears to
                                            be correct.

                      If IWORK(MSGX+J) = 1, the partial derivative with respect
                                            to the Jth column of X to be
                                            incorrect, i.e., the user supplied
                                            derivative and the finite
                                            difference value it is checked
                                            against do not agree to within the
                                            required tolerance and there is no
                                            reason to question the results.

                      If IWORK(MSGX+J) = 2, the partial derivative with respect
                                            to the Jth column of X appears to
                                            be questionable because the
                                            user supplied derivative and the
                                            finite difference value it is
                                            checked against are both zero.

                      If IWORK(MSGX+J) = 3, the partial derivative with respect
                                            to the Jth column of X appears to
                                            be questionable because the
                                            user supplied derivative is exactly
                                            zero and the finite difference
                                            value it is checked against is only
                                            approximately zero.

                      If IWORK(MSGX+J) = 4, the partial derivative with respect
                                            to the Jth column of X appears to
                                            be questionable because the
                                            user supplied derivative is exactly
                                            zero and the finite difference
                                            value it is checked against is not
                                            even approximately zero.

                      If IWORK(MSGX+J) = 5, the partial derivative with respect
                                            to the Jth column of X appears to
                                            be questionable because the finite
                                            difference value it is being
                                            checked against is questionable due
                                            to a high ratio of relative
                                            curvature to relative slope or to
                                            an incorrect scale value.

                      If IWORK(MSGX+J) = 6, the partial derivative with respect
                                            to the Jth column of X appears to
                                            be questionable because the finite
                                            difference value it is being
                                            checked against is questionable due
                                            to a high ratio of relative
                                            curvature to relative slope.

        IWORK(JPVTI)  is the first element of the NP vector, JPVT, containing
                      the pivot vector,

                         JPVT(I) = WORK(JPVTI-1+I)

                      for I=1,...,NP.

        IWORK(NNZWI)  is the number of nonzero observation error weights.

        IWORK(NPPI)   is the number of function parameters actually being
                      estimated.

    (*) IWORK(IDFI)   is the degrees of freedom of the fit, equal to the number
                      of observations with nonzero weighted derivatives with
                      respect to either BETA or DELTA minus the number of
                      parameters being estimated.

        IWORK(JOBI)   is the value used to specify problem initialization and
                      computational methods.

        IWORK(IPRINI) is the print control value used.

        IWORK(LUNERI) is the logical unit number used for error reports.

        IWORK(LUNRPI) is the logical unit number used for computation reports.

        IWORK(NROWI)  is the number of the row at which the derivative is to
                      be checked.

        IWORK(NTOLI)  is the number of digits of agreement required between the
                      numerical derivatives and the user supplied derivatives.

    (*) IWORK(NETAI)  is the number of good digits in the model function
                      results for the first row of the data not containing
                      zero.

        IWORK(MAXITI) is the maximum number of iterations allowed.

    (*) IWORK(NITERI) is the number of iterations taken.

    (*) IWORK(NFEVI)  is the number of function evaluations made.

    (*) IWORK(NJEVI)  is the number of Jacobian matrix evaluations made.

        IWORK(INT2I)  is the number of internal doubling steps taken at the
                      time the computations stopped.

    (*) IWORK(IRANKI) is the rank deficiency at the solution.

        IWORK(LDTTI)  is the leading dimension of the work array TT.



1   XI.  ACKNOWLEDGMENTS
         ---------------

    The ODRPACK code was developed at the National Institute of Standards and
    Technology (formerly the National Bureau of Standards).  The subroutine
    that supplies the value of machine precision was modeled after subroutines
    R1MACH and D1MACH from the Bell Laboratories "Framework for a Portable
    Library" [Fox et al., 1978].  We also use subroutines from LINPACK
    [Dongarra et al., 1979] and from the "Basic Linear Algebra Subprograms for
    Fortran Usage (BLAS)" [Lawson et al., 1979].  The code that checks user
    supplied derivatives was adapted from STARPAC [Donaldson and Tryon, 1986]
    using algorithms developed by Schnabel [1982].



1   XII.  REFERENCES
          ----------

    Boggs, P. T., R. H. Byrd, J. R. Donaldson and R. B. Schnabel (1987a),
      "ODRPACK -- Software for Weighted Orthogonal Distance Regression,"
      University of Colorado Department of Computer Science Technical Report
      Number CU-CS-360-87.  (To appear in ACM Trans. Math. Software.)

    Boggs, P. T., R. H. Byrd, and R. B. Schnabel (1987b),
      "A stable and efficient algorithm for nonlinear orthogonal
      distance regression," SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.

    Boggs, P. T., and J. R. Donaldson (1989),
      "The Computation and Use of the Asymptotic Covariance Matrix for 
      Measurement Error Models,"
      National Institute of Standards and Technology Internal Report 89-4102.

    Dennis, J. E., and R. B. Schnabel (1983),
      NUMERICAL METHODS FOR UNCONSTRAINED OPTIMIZATION AND NONLINEAR
      EQUATIONS, Prentice-Hall, Englewood Cliffs, NJ.

    Donaldson, J. R., and R. B. Schnabel (1987),
      "Computational Experience with Confidence Regions and Confidence
      Intervals for Nonlinear Least Squares," TECHNOMETRICS, 29(1):67-82.

    Donaldson, J. R., and P. V. Tryon (1986),
      "STARPAC - the standards time series and regression package,"
      National Bureau of Standards (U.S.) Interim Report 86-3448.

    Dongarra, J. J., C. B. Moler, J. R. Bunch, and G. W. Stewart (1979),
      LINPACK USERS' GUIDE, SIAM, Philadelphia, PA.

    Draper, N. R., and H. Smith (1981),
      APPLIED REGRESSION ANALYSIS, Second Edition, John Wiley and Sons,
      New York, NY.

    Efron, B. (1985),
      "The Jackknife, the Bootstrap and Other Resampling Plans,"
      Monograph 38 (CBMS-NFS), SIAM, Philadelphia, PA.

    Fox, P. A., A. D. Hall and N. L. Schryer (1978),
      "Algorithm 528:  framework for a portable library [z]," ACM TRANS.
      MATH.  SOFTWARE, 4(2):177-188.

    Fuller, W. A. (1987),
      MEASUREMENT ERROR MODELS, John Wiley and Sons, New York, NY.

    Gill, P. E., W. Murray and M. H. Wright (1981),
      PRACTICAL OPTIMIZATION, Academic Press, New York, NY.

    Himmelblau, D. M. (1970),
      PROCESS ANALYSIS BY STATISTICAL METHODS, John Wiley and Sons, New
      York, NY.

1   Lawson, C., R. Hanson, D. Kincaid, and F. Krogh (1979),
      "Basic linear algebra subprograms for fortran usage", ACM TRANS.
      MATH.  SOFTWARE, 5(3):308-371.

    Schnabel, R. B. (1982),
      "Finite difference derivatives - theory and practice",
      (unpublished, available from author).

      PROGRAM SAMPLE
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER
C  WHERE  MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED
C          LDX IS THE LEADING DIMENSION OF ARRAY X
C         LDWD IS THE LEADING DIMENSION OF ARRAY WD
C        LWORK IS THE DIMENSION OF VECTOR WORK
C       LIWORK IS THE DIMENSION OF VECTOR IWORK
*
C...PARAMETERS
      INTEGER
     +   MAXN,MAXM,MAXNP,LDX,LDWD,LWORK,LIWORK
      PARAMETER
     +   (MAXN=15,
     +   MAXM=5,
     +   MAXNP=5,
     +   LDX=MAXN,
     +   LDWD=1,
     +   LWORK = 17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
     +   LIWORK = 19 + 2*MAXNP + MAXM)
*
C  DECLARE USER-SUPPLIED SUBROUTINES AND
C  ALL OTHER NECESSARY VARIABLES AND ARRAYS
*
C...LOCAL SCALARS
      INTEGER
     +   I,INFO,IPRINT,J,JOB,LUNERR,LUNRPT,M,N,NP
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   BETA(MAXNP),WD(LDWD,MAXM),WORK(LWORK),
     +   X(LDX,MAXM),Y(LDX)
      INTEGER
     +   IWORK(LIWORK)
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DODR,FUN,JAC
*
*
      OPEN(UNIT=5,FILE='DATA1')
      OPEN(UNIT=6,FILE='REPORT')
*
C  READ NUMBER OF OBSERVATIONS
C       NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE
C       NUMBER OF PARAMETERS
C       OBSERVED VALUES OF INDEPENDENT AND DEPENDENT VARIABLES
C       STARTING VALUES OF FUNCTION PARAMETERS
*
      READ (5,*) N,M,NP
      READ (5,*) ((X(I,J),I=1,N),J=1,M)
      READ (5,*) (Y(I),I=1,N)
      READ (5,*) (BETA(I),I=1,NP)
*
C  SPECIFY DELTA WEIGHTS
*
      WD(1,1) = 3.0D0
      WD(1,2) = 5.0D0
*
C  SET CONTROL VALUES TO INVOKE DEFAULT SETTING
*
      JOB = -1
      IPRINT = -1
      LUNERR = -1
      LUNRPT = -1
*
C  COMPUTE ODR SOLUTION USING FINITE-DIFFERENCE DERIVATIVES
*
      CALL DODR
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,
     +   Y,
     +   BETA,
     +   WD,LDWD,
     +   JOB,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
*
      END
      SUBROUTINE FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
*
C  INPUT ARGUMENTS
C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
C     INTEGER N,NP,M,LDXPD
C     DOUBLE PRECISION BETA(NP),XPLUSD(LDXPD,M)
C  OUTPUT ARGUMENTS
C     DOUBLE PRECISION F(N)
C     INTEGER ISTOPF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPF,LDXPD,M,N,NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),F(N),XPLUSD(LDXPD,M)
*
C...LOCAL SCALARS
      INTEGER
     +   I
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
*
      DO 10 I = 1, N
         IF (XPLUSD(I,2).NE.0.0D0) THEN
            F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
     +             EXP(-BETA(2)*
     +                  (1.0D0/XPLUSD(I,2) - 1.0D0/620.0D0)))
         ELSE
            ISTOPF = 1
            RETURN
         END IF
   10 CONTINUE
      ISTOPF = 0
*
      RETURN
      END
      PROGRAM SAMPLE
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER
C  WHERE  MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED
C          LDX IS THE LEADING DIMENSION OF ARRAY X
C       LDSCLD IS THE LEADING DIMENSION OF ARRAY SCLD
C         LDWD IS THE LEADING DIMENSION OF ARRAY WD
C        LDIFX IS THE LEADING DIMENSION OF ARRAY IFIXX
C        LWORK IS THE DIMENSION OF VECTOR WORK
C       LIWORK IS THE DIMENSION OF VECTOR IWORK
*
C...PARAMETERS
      INTEGER
     +   MAXN,MAXM,MAXNP,LDSCLD,LDIFX,LDWD,LWORK,LIWORK
      PARAMETER
C    +   (MAXN=15,
     +   MAXM=5,
     +   MAXNP=5,
     +   LDSCLD=1,
     +   LDWD=1,
     +   LDIFX=1,
     +   LWORK=17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
     +   LIWORK=19 + 2*MAXNP + MAXM)
*
C  DECLARE USER-SUPPLIED SUBROUTINES AND
C  ALL OTHER NECESSARY VARIABLES AND ARRAYS
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   I,INFO,IPRINT,J,JOB,LDX,LUNERR,LUNRPT,M,MAXIT,N,NDIGIT,NP
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   BETA(MAXNP),WD(LDWD,MAXM),SCLB(MAXNP),
     +   SCLD(LDSCLD,MAXM),W(MAXN),WORK(LWORK),X(MAXN,MAXM),Y(MAXN)
      INTEGER
     +   IFIXB(MAXNP),IFIXX(LDIFX,MAXM),IWORK(LIWORK)
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DODRC,FUN,JAC
*
*
      OPEN(UNIT=5,FILE='DATA1')
      OPEN(UNIT=6,FILE='REPORT')
*
C  SPECIFY LEADING DIMENSION OF ARRAY X
*
      LDX = MAXN
*
C  READ NUMBER OF OBSERVATIONS
C       NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE
C       NUMBER OF PARAMETERS
C       OBSERVED VALUES OF INDEPENDENT AND DEPENDENT VARIABLES
C       STARTING VALUES OF FUNCTION PARAMETERS
*
      READ (5,*) N,M,NP
      READ (5,*) ((X(I,J),I=1,N),J=1,M)
      READ (5,*) (Y(I),I=1,N)
      READ (5,*) (BETA(I),I=1,NP)
*
C  FIX SECOND COLUMN OF INDEPENDENT VARIABLE AT OBSERVED VALUES
*
      IFIXX(1,1) = 1
      IFIXX(1,2) = 0
*
C  SPECIFY USE OF DEFAULT SCALING
*
      SCLD(1,1) = -1.0D0
      SCLB(1) = -1.0D0
*
C  INDICATE ALL BETA'S ARE TO BE ESTIMATED
*
      IFIXB(1) = -1
*
C  SPECIFY WEIGHTS
*
      WD(1,1) = 3.0D0
      WD(1,2) = 5.0D0
      W(1) = -1.0D0
*
C  SET CONTROL VALUES AND STOPPING CRITERIA
*
      JOB = 10
      NDIGIT = -1
      TAUFAC = -1.0D0
      SSTOL = -1.0D0
      PARTOL = -1.0D0
      MAXIT = -1
      IPRINT = 1111
      LUNERR = -1
      LUNRPT = -1
*
C  COMPUTE ODR SOLUTION USING USER-SUPPLIED ANALYTIC DERIVATIVES
*
      CALL DODRC
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   Y,
     +   BETA,IFIXB,SCLB,
     +   WD,LDWD,W,
     +   JOB,NDIGIT,TAUFAC,
     +   SSTOL,PARTOL,MAXIT,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
*
      END
      SUBROUTINE FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
*
C  INPUT ARGUMENTS
C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
*
C     INTEGER N,NP,M,LDXPD
C     DOUBLE PRECISION BETA(NP),XPLUSD(LDXPD,M)
*
C  OUTPUT ARGUMENTS
*
C     DOUBLE PRECISION F(N)
C     INTEGER ISTOPF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPF,LDXPD,M,N,NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +    BETA(NP),F(N),XPLUSD(LDXPD,M)
*
C...LOCAL SCALARS
      INTEGER
     +    I
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +    EXP
*
*
      DO 10 I = 1, N
         IF (XPLUSD(I,2).NE.0.0D0) THEN
            F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
     +             EXP(-BETA(2)*
     +                  (1.0D0/XPLUSD(I,2) - 1.0D0/620.0D0)))
         ELSE
            ISTOPF = 1
            RETURN
         END IF
   10 CONTINUE
      ISTOPF = 0
*
      RETURN
      END
      SUBROUTINE JAC(N,NP,M,BETA,XPLUSD,LDXPD,
     +               FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOPJ)
*
C  INPUT ARGUMENTS
C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
*
C     INTEGER N,NP,M,LDXPD
C     DOUBLE PRECISION BETA(NP),XPLUSD(LDXPD,M)
C     LOGICAL ISODR
*
C  OUTPUT ARGUMENTS
*
C     DOUBLE PRECISION FJACB(LDFJB,NP),FJACX(LDFJX,M)
C     INTEGER ISTOPJ
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPJ,LDFJB,LDFJX,LDXPD,M,N,NP
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),FJACB(LDFJB,NP),FJACX(LDFJX,M),XPLUSD(LDXPD,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   FAC1,FAC2,FAC3,FAC4
      INTEGER
     +   I
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
*
      DO 10 I=1,N
         FAC1 = 1.0D0/XPLUSD(I,2) - 1.0D0/620.0D0
         FAC2 = EXP(-BETA(2)*FAC1)
         FAC3 = BETA(1)*XPLUSD(I,1)
         FAC4 = EXP(-FAC3*FAC2)
*
         FJACB(I,1) = -FAC4*XPLUSD(I,1)*FAC2
         FJACB(I,2) = FAC4*FAC3*FAC2*FAC1
*
         IF (ISODR) THEN
            FJACX(I,1) = -FAC4*BETA(1)*FAC2
            FJACX(I,2) = -FAC4*FAC3*FAC2*BETA(2)/XPLUSD(I,2)**2
         END IF
   10 CONTINUE
      ISTOPJ = 0
*
      RETURN
      END
*DTEST
      PROGRAM DTEST
C***BEGIN PROLOGUE  TEST
C***REFER TO DODR,DODRC
C***ROUTINES CALLED  DODRX
C***DATE WRITTEN   861229   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  EXERCISE FEATURES OF ODRPACK SOFTWARE
C***END PROLOGUE  ODRPACK
*
C...SCALARS IN COMMON
      INTEGER
     +   NTEST
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   TSTFAC
      INTEGER
     +   LUNERR,LUNRPT,LUNSUM
      LOGICAL
     +   PASSED
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DODRX
*
C...COMMON BLOCKS
      COMMON /TSTSET/ NTEST
*
C***VARIABLE DECLARATIONS (ALPHABETICALLY)
*
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNSUM
C        THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT THAT LISTS
C        ONLY THE TEST COMPARISONS AND NOT THE ODRPACK GENERATED
C        REPORTS.
C     INTEGER NTEST
C        THE NUMBER OF TESTS TO BE RUN.
C     LOGICAL PASSED
C        THE INDICATOR VALUE USED TO DESIGNATES WHETHER THE RESULTS OF
C        ALL OF THE TESTS AGREE WITH THOSE FROM THE CDC CYBER 205 USING
C        DOUBLE PRECISION (PASSED=TRUE), OR WHETHER SOME OF THE RESULTS
C        DISAGREED (PASSED=FALSE).
C     DOUBLE PRECISION TSTFAC
C        THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES USED
C        TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND RESULTS
C        OBTAINED USING DOUBLE PRECISION VERSION ON CDC CYBER 205.
C        VALUES OF TSTFAC GREATER THAN ONE INCREASE THE TEST TOLERANCES,
C        MAKING THE TESTS EASIER TO PASS AND ALLOWING SMALL
C        DISCREPANCIES BETWEEN THE COMPUTED AND EXPECTED RESULTS TO BE
C        AUTOMATICALLY DISCOUNTED.
*
*
C***FIRST EXECUTABLE STATEMENT  TEST
*
*
C  SET UP NECESSARY FILES
*
C  NOTE:  ODRPACK GENERATES COMPUTATION AND ERROR REPORTS ON
C         LOGICAL UNIT 6 BY DEFAULT;
C         LOGICAL UNIT 'LUNSUM' USED TO SUMMARIZE RESULTS OF COMPARISONS
C         FROM EXERCISE ROUTINE DODRX.
*
      LUNRPT = 18
      LUNERR = 18
      LUNSUM = 19
*
      OPEN(UNIT=LUNRPT,FILE='REPORT')
      OPEN(UNIT=LUNERR,FILE='REPORT')
      OPEN(UNIT=LUNSUM,FILE='SUMMARY')
*
C  EXERCISE DOUBLE PRECISION VERSION OF ODRPACK
C  (TEST REPORTS GENERATED ON FILE 'RESULTS' AND
C   SUMMARIZED IN FILE 'SUMMARY')
*
      NTEST = 10
      TSTFAC = 1.0D0
      CALL DODRX(TSTFAC,PASSED,LUNSUM)
*
      END
*DODRX
      SUBROUTINE DODRX
     +   (TSTFAC,PASSED,LUNSUM)
C***BEGIN PROLOGUE  DODRX
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  EXERCISE FEATURES OF ODRPACK SOFTWARE
C***DESCRIPTION
C     DODRX SUBPROGRAM ARGUMENTS:
C     DOUBLE PRECISION TSTFAC
C        THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES USED
C        TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND RESULTS
C        OBTAINED USING DOUBLE PRECISION VERSION ON CDC CYBER 205.
C        VALUES OF TSTFAC GREATER THAN ONE INCREASE THE TEST TOLERANCES,
C        MAKING THE TESTS EASIER TO PASS AND ALLOWING SMALL
C        DISCREPANCIES BETWEEN THE COMPUTED AND EXPECTED RESULTS TO BE
C        AUTOMATICALLY DISCOUNTED.
C     LOGICAL PASSED
C        THE INDICATOR VALUE USED TO DESIGNATES WHETHER THE RESULTS OF
C        ALL OF THE TESTS AGREE WITH THOSE FROM THE CDC CYBER 205 USING
C        DOUBLE PRECISION (PASSED=TRUE), OR WHETHER SOME OF THE RESULTS
C        DISAGREED (PASSED=FALSE).
C     INTEGER LUNSUM
C        THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT THAT LISTS
C        ONLY THE TEST COMPARISONS AND NOT THE ODRPACK GENERATED
C        REPORTS, WHICH ARE WRITTEN TO UNIT 6.
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  DIWINF,DMPREC,DNRM2,DODR,DODRC,DODRXD,
C                    DODRXF,DODRXJ,DODRXW,DWINF,DZERO,
C***END PROLOGUE  DODRX
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER, WHERE
C       LIWORK IS THE LENGTH OF THE WORK VECTOR IWORK.
C        LWORK IS THE LENGTH OF THE WORK VECTOR WORK.
C         MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED,
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED,
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED, AND
C       NTESTS IS THE NUMBER OF DIFFERENT TESTS THAT CAN BE RUN.
*
C...PARAMETERS
      INTEGER
     +   LIWORK,LWORK,MAXN,MAXM,MAXNP,NTESTS
      PARAMETER
C    +   (MAXN=50, MAXNP=10, MAXM=3, NTESTS=10,
     +   LWORK = 17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
     +   LIWORK = 19 + 2*MAXNP + MAXM)
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   TSTFAC
      INTEGER
     +   LUNSUM
      LOGICAL
     +   PASSED
*
C...SCALARS IN COMMON
      INTEGER
     +   NTEST,SETNO
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   BNRM,EPSMAC,HUNDRD,ONE,P01,P2,PARTOL,RSSQ,SSTOL,
     +   TAUFAC,TSTTOL,TWO,ZERO
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSI,EPSMAI,ETAI,FJACBI,FJACXI,FNI,FSI,I,IDFI,INFO,INT2I,
     +   IPRINI,IPRINT,IRANKI,ITEST,JOB,JOBI,JPVTI,L,LDIFX,LDSCLD,LDTTI,
     +   LDWD,LDX,LIWKMN,LIWMIN,LUN,LUNERI,LUNERR,LUNRPI,LUNRPT,LWKMN,
     +   LWMIN,M,MAXIT,MAXITI,MSG,MSGB,MSGX,N,NDIGIT,NETAI,NFEVI,NITERI,
     +   NJEVI,NNZWI,NP,NPPI,NROWI,NTOLI,OLMAVI,OMEGAI,PARTLI,PNORMI,
     +   PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,SEI,SI,SSFI,SSI,SSSI,
     +   SSTOLI,TAUFCI,TAUI,TI,TTI,UI,VCVI,WRK1I,WSSI,WSSDEI,WSSEPI,
     +   XPLUSI,YTI
      LOGICAL
     +   FAILED,FAILS,SHORT
      CHARACTER TITLE*80
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   BETA(MAXNP),DP205(2,NTESTS),
     +   SCLB(MAXNP),SCLD(MAXN,MAXM),W(MAXN),WD(MAXN,MAXM),WORK(LWORK),
     +   X(MAXN,MAXM),Y(MAXN)
      INTEGER
     +   IDP205(NTESTS),IFIXB(MAXNP),IFIXX(MAXN,MAXM),IWORK(LIWORK)
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DMPREC,DNRM2
      EXTERNAL
     +   DMPREC,DNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DIWINF,DODR,DODRC,DODRXD,DODRXF,DODRXJ,DODRXW,DWINF,DZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MOD
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
      COMMON /TSTSET/ NTEST
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P01,P2,ONE,TWO,HUNDRD
     +   /0.0D0,0.01D0,0.2D0,1.0D0,2.0D0,100.0D0/
*
      DATA
     +   (DP205(I,1),I=1,2)
     +   /0.276273319578025680897844934084D+05,
     +    0.753263956902291894369510458488D-03/
      DATA
     +   (DP205(I,2),I=1,2)
     +   /0.276273263014367271057285851346D+05,
     +    0.753846772268713150687427932817D-03/
      DATA
     +   (DP205(I,3),I=1,2)
     +   /0.106994410000000002794090519414D+10,
     +    0.121280859325605635962966065824D-04/
      DATA
     +   (DP205(I,4),I=1,2)
     +   /0.106994410000000002662346114304D+10,
     +    0.545208463379060601757201499747D-06/
      DATA
     +   (DP205(I,5),I=1,2)
     +   /0.142698815637725861752157173592D+01,
     +    0.108472868712743221975390382045D+01/
      DATA
     +   (DP205(I,6),I=1,2)
     +   /0.426132182951397887187250887403D+01,
     +    0.147796721039842073356542433095D-01/
      DATA
     +   (DP205(I,7),I=1,2)
     +   /0.426127230714288607663880633106D+01,
     +    0.147796612546537433680413855128D-01/
      DATA
     +   (DP205(I,8),I=1,2)
     +   /0.437148731790976277721640707488D+02,
     +    0.114441947440828606711224215902D-02/
      DATA
     +   (DP205(I,9),I=1,2)
     +   /0.395094925302768220710923336357D+02,
     +    0.665183875083491081963688151467D+02/
      DATA
     +   (DP205(I,10),I=1,2)
     +   /0.395094925302768220710923336357D+02,
     +    0.665183875083491081963688151467D+02/
*
      DATA
     +   (IDP205(I),I=1,10)
     +   /1,1,1,1,101,4,1,1,1023,40100/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL DODRXF
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL DODRXJ
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     DOUBLE PRECISION BETA(MAXNP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     DOUBLE PRECISION BNRM
C        THE NORM OF THE BETA.
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     DOUBLE PRECISION DP205(2,NTESTS)
C         THE FLOATING POINT RESULTS FROM A CDC CYBER 205 USING
C         DOUBLE PRECISION.
C     INTEGER EPSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     LOGICAL FAILED
C        THE INDICATOR VALUE USED TO DESIGNATE WHETHER THE RESULTS OF
C        ALL OF THE DEMONSTRATION RUNS AGREED WITH THOSE FROM THE
C        CDC CYBER 205 USING DOUBLE PRECISION (FAILED=FALSE) OR WHETHER
C        SOME OF THE TESTS DISAGREED (FAILED=TRUE).
C     LOGICAL FAILS
C        THE INDICATOR VALUE USED TO DESIGNATE WHETHER THE RESULTS OF
C        AN INDIVIDUAL DEMONSTRATION RUN AGREED WITH THOSE FROM THE
C        CDC CYBER 205 USING DOUBLE PRECISION (FAILS=FALSE) OR DISAGREE
C        (FAILS=TRUE).
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     DOUBLE PRECISION HUNDRD
C        THE VALUE 100.0D0.
C     INTEGER I
C        AN INDEX VARIABLE.
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IDP205(NTESTS)
C         THE INTEGER RESULTS FROM A CDC CYBER 205 USING
C         DOUBLE PRECISION.
C     INTEGER IFIXB(MAXNP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(MAXN,MAXM)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER ITEST
C        THE NUMBER OF THE CURRENT TEST BEING RUN.
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LIWMIN
C        THE MINIMUM LENGTH OF VECTOR IWORK FOR A GIVEN PROBLEM.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUN
C        THE LOGICAL UNIT NUMBER CURRENTLY BEING USED.
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNSUM
C        THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT.
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWMIN
C        THE MINIMUM LENGTH OF VECTOR WORK FOR A GIVEN PROBLEM.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSG
C        AN INDICATOR VARIABLE USED TO DESIGNATE WHICH MESSAGE IS
C        TO BE PRINTED AS A RESULT OF THE COMPARISON WITH THE CDC CYBER
C        205 RESULTS.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTEST
C        THE NUMBER OF TESTS TO BE RUN.
C     INTEGER NTESTS
C        THE NUMBER OF DIFFERENT TESTS AVAILABLE.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY DJCK.
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     LOGICAL PASSED
C        THE INDICATOR VALUE USED TO DESIGNATES WHETHER THE RESULTS OF
C        ALL OF THE DEMONSTRATION RUNS AGREED WITH THOSE FROM THE
C        CDC CYBER 205 USING DOUBLE PRECISION (PASSED=TRUE), OR WHETHER
C        SOME OF THE RESULTS DISAGREED (PASSED=FALSE).
C     DOUBLE PRECISION P01
C        THE VALUE 0.01D0.
C     DOUBLE PRECISION P2
C        THE VALUE 0.2D0.
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION RSSQ
C        THE NORM OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE.
C     DOUBLE PRECISION SCLB(MAXNP)
C        THE SCALE VALUE FOR EACH VALUE OF BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(MAXN,MAXM)
C        THE SCALE VALUE FOR EACH VALUE OF DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STANDARD ERRORS FOR THE PARAMETERS, ALSO USED AS A
C        WORK ARRAY.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER ODRPACK IS TO
C        BE INVOKED BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-CALL
C        (SHORT=.FALSE.).
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     CHARACTER*80 TITLE
C        THE REFERENCE FOR THE DATA SET BEING ANALYZED.
C     DOUBLE PRECISION TSTFAC
C        THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES
C        USED TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND
C        RESULTS OBTAINED USING DOUBLE PRECISION VERSION ON CDC
C        CYBER 205.
C     DOUBLE PRECISION TSTTOL
C        THE TEST TOLERANCE USED IN CHECKING COMPUTED VALUES FOR
C        PURPOSES OF DETERMINING PROPER INSTALLATION.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     DOUBLE PRECISION TWO
C          THE VALUE 2.0D0.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     INTEGER VCVI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE VARIANCE COVARIANCE MATRIX, ALSO USED
C        TO STORE THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     DOUBLE PRECISION W(MAXN)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(MAXN,MAXM)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WORK(LWORK)
C        THE DOUBLE PRECISION WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     DOUBLE PRECISION X(MAXN,MAXM)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION Y(MAXN)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER YTI
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODRX
*
*
C  SET LOGICAL UNITS FOR ERROR AND COMPUTATION REPORTS
*
      LUNERR = 18
      LUNRPT = 18
*
C  INITIALIZE TEST TOLERANCE
*
      IF (TSTFAC.GT.ONE) THEN
         TSTTOL = TSTFAC
      ELSE
         TSTTOL = ONE
      END IF
*
C  INITIALIZE MACHINE PRECISION
*
      EPSMAC = DMPREC()
*
C  INITIALIZE LEADING DIMENSION OF X
*
      LDX = MAXN
*
C  INITIALIZE MISCELLANEOUS VARIABLES USED IN THE EXERCISE PROCEDURE
*
      FAILED = .FALSE.
      SHORT = .TRUE.
      N = 0
*
C  BEGIN EXERCISING ODRPACK
*
      DO 400 ITEST=1,NTEST
*
C  SET CONTROL VALUES TO INVOKE DEFAULT VALUES
*
         IFIXX(1,1) = -1
         LDIFX = MAXN
         IFIXB(1) = -1
         W(1) = -ONE
         NDIGIT = -1
         TAUFAC = -ONE
         SSTOL = -ONE
         PARTOL = -ONE
         MAXIT = -1
         IPRINT = 2112
*
         IF (ITEST.EQ.1) THEN
*
C  TEST SIMPLE ODR PROBLEM WITH ANALYTIC DERIVATIVES USING DODR
*
            LUN = LUNRPT
            DO 10 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1010)
               LUN = LUNSUM
   10       CONTINUE
            SETNO = 5
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00010
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = 1
            SHORT = .TRUE.
         ELSE IF (ITEST.EQ.2) THEN
*
C  TEST SIMPLE OLS PROBLEM WITH FINITE DIFFERENCE DERIVATIVES USING DODR
*
            LUN = LUNRPT
            DO 20 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1020)
               LUN = LUNSUM
   20       CONTINUE
            SETNO = 5
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00001
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = 1
            SHORT = .TRUE.
         ELSE IF (ITEST.EQ.3) THEN
*
C  TEST PARAMETER FIXING CAPABILITIES FOR POORLY SCALED OLS PROBLEM
C  WITH ANALYTIC DERIVATIVES USING DODRC.
*
            LUN = LUNRPT
            DO 30 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1030)
               LUN = LUNSUM
   30       CONTINUE
            SETNO = 3
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00031
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = 1
            SHORT = .FALSE.
            IFIXB(1) = 1
            IFIXB(2) = 1
            IFIXB(3) = 1
            IFIXB(4) = 0
            IFIXB(5) = 1
            IFIXB(6) = 0
            IFIXB(7) = 0
            IFIXB(8) = 0
            IFIXB(9) = 0
         ELSE IF (ITEST.EQ.4) THEN
*
C  TEST WEIGHTING CAPABILITIES FOR ODR PROBLEM WITH
C  ANALYTIC DERIVATIVES USING DODRC.
C  ALSO SHOWS SOLUTION OF POORLY SCALED ODR PROBLEM
C  (DERIVATIVE CHECKING TURNED OFF)
*
            LUN = LUNRPT
            DO 40 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1040)
               LUN = LUNSUM
   40       CONTINUE
            SETNO = 3
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00020
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            DO 45 I=1,N
               WD(I,1) = P01/ABS(X(I,1))
               W(I) = ONE
   45       CONTINUE
            LDWD = N
            W(28) = ZERO
            SHORT = .FALSE.
            IFIXB(1) = 1
            IFIXB(2) = 1
            IFIXB(3) = 1
            IFIXB(4) = 0
            IFIXB(5) = 1
            IFIXB(6) = 1
            IFIXB(7) = 1
            IFIXB(8) = 0
            IFIXB(9) = 0
            IPRINT = 2232
         ELSE IF (ITEST.EQ.5) THEN
*
C  TEST DELTA INITIALIZATION CAPABILITIES AND USER-SUPPLIED SCALING
C  TEST DELTA INITIALIZATION CAPABILITIES
C  AND USE OF ISTOPF TO RESTRICT PARAMETER VALUES
C  FOR ODR PROBLEM WITH ANALYTIC DERIVATIVES USING DODRC.
*
            LUN = LUNRPT
            DO 50 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1050)
               LUN = LUNSUM
   50       CONTINUE
            SETNO = 1
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 01010
            SCLD(1,1) = TWO
            LDSCLD = 1
            SCLB(1) = P2
            SCLB(2) = ONE
            WD(1,1) = -ONE
            LDWD = N
            DO 55 I=20,21
               WORK(I) = BETA(1)/Y(I) + BETA(2) - X(I,1)
   55       CONTINUE
            SHORT = .FALSE.
         ELSE IF (ITEST.EQ.6) THEN
*
C  TEST STIFF STOPPING CONDITIONS FOR UNSCALED ODR PROBLEM
C  WITH ANALYTIC DERIVATIVES USING DODRC
*
            LUN = LUNRPT
            DO 60 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1060)
               LUN = LUNSUM
   60       CONTINUE
            SETNO = 4
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00010
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
            SSTOL = HUNDRD*EPSMAC
            PARTOL = EPSMAC
            MAXIT = 2
         ELSE IF (ITEST.EQ.7) THEN
*
C  TEST RESTART FOR UNSCALED ODR PROBLEM
C  WITH ANALYTIC DERIVATIVES USING DODRC
*
            LUN = LUNRPT
            DO 70 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1070)
               LUN = LUNSUM
   70       CONTINUE
            SETNO = 4
            JOB = 20210
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
            SSTOL = HUNDRD*EPSMAC
            PARTOL = EPSMAC
            MAXIT = -1
         ELSE IF (ITEST.EQ.8) THEN
*
C  TEST USE OF TAUFAC TO RESTRICT FIRST STEP
C  FOR ODR PROBLEM WITH FINITE DIFFERENCE DERIVATIVES USING DODRC.
*
            LUN = LUNRPT
            DO 80 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1080)
               LUN = LUNSUM
   80       CONTINUE
            SETNO = 6
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00200
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
            TAUFAC = P01
         ELSE IF (ITEST.EQ.9) THEN
*
C  TEST DETECTION OF INCORRECT DERIVATIVES
*
            LUN = LUNRPT
            DO 90 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1090)
               LUN = LUNSUM
   90       CONTINUE
            SETNO = 6
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00011
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
         ELSE IF (ITEST.EQ.10) THEN
*
C  TEST DETECTION OF INCORRECT DERIVATIVES
*
            LUN = LUNRPT
            DO 100 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1100)
               LUN = LUNSUM
  100       CONTINUE
            SETNO = 6
            CALL DODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL DZERO(LWORK,1,WORK,LWORK)
            JOB = 00010
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
         END IF
*
         CALL DIWINF
     +      (M,NP,
     +      MSGB,MSGX,JPVTI,
     +      NNZWI,NPPI,IDFI,
     +      JOBI,IPRINI,LUNERI,LUNRPI,
     +      NROWI,NTOLI,NETAI,
     +      MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +      LIWKMN)
         CALL DWINF
     +      (N,M,NP,
     +      DELTAI,EPSI,
     +      WSSI,WSSDEI,WSSEPI,RVARI,
     +      PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +      FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +      DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +      ALPHAI,VCVI,OMEGAI,YTI,UI,QRAUXI,WRK1I,SEI,RCONDI,
     +      ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +      LWKMN)
         CALL DODRXW
     +      (N,M,NP,LIWMIN,LWMIN)
*
C  COMPUTE OLS SOLUTION USING ODRPAK WITH F.D. DERIVATIVES
*
         WRITE (LUNRPT,2200) TITLE
         WRITE (LUNSUM,2200) TITLE
         IF (SHORT) THEN
            CALL DODR
     +         (DODRXF,DODRXJ,
     +         N,M,NP,
     +         X,LDX,
     +         Y,
     +         BETA,
     +         WD,LDWD,
     +         JOB,
     +         IPRINT,LUNERR,LUNRPT,
     +         WORK,LWMIN,IWORK,LIWMIN,
     +         INFO)
         ELSE
            CALL DODRC
     +         (DODRXF,DODRXJ,
     +         N,M,NP,
     +         X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +         Y,
     +         BETA,IFIXB,SCLB,
     +         WD,LDWD,W,
     +         JOB,NDIGIT,TAUFAC,
     +         SSTOL,PARTOL,MAXIT,
     +         IPRINT,LUNERR,LUNRPT,
     +         WORK,LWMIN,IWORK,LIWMIN,
     +         INFO)
         END IF
*
C  COMPARE RESULTS WITH THOSE OBTAINED ON THE CDC CYBER 205
C  USING DOUBLE PRECISION VERSION OF ODRPACK
*
         BNRM = DNRM2(NP,BETA,1)
         RSSQ = WORK(WSSI)
*
         IF (IDP205(ITEST).EQ.INFO) THEN
*
C  STOPPING CONDITIONS AGREE
*
            IF (INFO.GE.10000) THEN
               FAILS = .FALSE.
               MSG = 1
*
            ELSE
               IF (MOD(INFO,10).EQ.1) THEN
                  FAILS = ABS(RSSQ-DP205(2,ITEST)).GT.
     +                    DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.2) THEN
                  FAILS = ABS(BNRM-DP205(1,ITEST)).GT.
     +                    DP205(1,ITEST)*WORK(PARTLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.3) THEN
                  FAILS = (ABS(RSSQ-DP205(2,ITEST)).GT.
     +                     DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL)
     +                    .AND.
     +                    (ABS(BNRM-DP205(1,ITEST)).GT.
     +                     DP205(1,ITEST)*WORK(PARTLI)*TSTTOL)
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.4) THEN
                  FAILS = .FALSE.
                  MSG = 1
*
               ELSE
                  FAILS = .TRUE.
                  MSG = 4
               END IF
            END IF
*
         ELSE
            IF (INFO.GE.10000) THEN
               FAILS = .TRUE.
               MSG = 3
*
            ELSE
               IF (MOD(INFO,10).EQ.1) THEN
                  FAILS = ABS(RSSQ-DP205(2,ITEST)).GT.
     +                    DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.2) THEN
                  FAILS = ABS(BNRM-DP205(1,ITEST)).GT.
     +                    DP205(1,ITEST)*WORK(PARTLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.3) THEN
                  FAILS = (ABS(RSSQ-DP205(2,ITEST)).GT.
     +                     DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL)
     +                    .AND.
     +                    (ABS(BNRM-DP205(1,ITEST)).GT.
     +                     DP205(1,ITEST)*WORK(PARTLI)*TSTTOL)
                  MSG = 2
*
               ELSE
                  FAILS = .TRUE.
                  MSG = 3
               END IF
            END IF
         END IF
*
         FAILED = FAILED .OR. FAILS
*
         LUN = LUNRPT
         DO 300 L=1,2
            WRITE (LUN,3100)
            WRITE (LUN,3210) ' CDC CYBER 205 RESULT = ',
     +         DP205(1,ITEST),DP205(2,ITEST),IDP205(ITEST)
            WRITE (LUN,3210) ' NEW TEST RESULT      = ',
     +         BNRM,RSSQ,INFO
            WRITE (LUN,3210) ' DIFFERENCE           = ',
     +         ABS(DP205(1,ITEST)-BNRM),ABS(DP205(2,ITEST)-RSSQ),
     +         ABS(IDP205(ITEST)-INFO)
*
            IF (MSG.EQ.1) THEN
               WRITE (LUN,3310)
            ELSE IF (MSG.EQ.2) THEN
               IF (FAILS) THEN
                  WRITE (LUN,3320)
               ELSE
                  WRITE (LUN,3330)
               END IF
            ELSE IF (MSG.EQ.3) THEN
               WRITE (LUN,3340)
            ELSE IF (MSG.EQ.4) THEN
               WRITE (LUN,3350)
            END IF
*
            LUN = LUNSUM
  300    CONTINUE
  400 CONTINUE
*
      IF (FAILED) THEN
         WRITE (LUNSUM,4100)
         PASSED = .FALSE.
      ELSE
         WRITE (LUNSUM,4200)
         PASSED = .TRUE.
      END IF
*
C  FORMAT STATEMENTS
*
 1000 FORMAT('1EXAMPLE ', I2/)
 1010 FORMAT(' TEST SIMPLE ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING DODR.')
 1020 FORMAT(' TEST SIMPLE OLS PROBLEM'/
     +       ' WITH FINITE DIFFERENCE DERIVATIVES',
     +       ' USING DODR.')
 1030 FORMAT(' TEST PARAMETER FIXING CAPABILITIES',
     +       ' FOR POORLY SCALED OLS PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING DODRC.')
 1040 FORMAT(' TEST WEIGHTING CAPABILITIES',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING DODRC. '/
     +       ' ALSO SHOWS SOLUTION OF POORLY SCALED',
     +       ' ODR PROBLEM.'/
     +       ' (DERIVATIVE CHECKING TURNED OFF.)')
 1050 FORMAT(' TEST DELTA INITIALIZATION CAPABILITIES'/
     +       ' AND USE OF ISTOPF TO RESTRICT PARAMETER VALUES',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING DODRC.')
 1060 FORMAT(' TEST STIFF STOPPING CONDITIONS',
     +       ' FOR UNSCALED ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING DODRC.')
 1070 FORMAT(' TEST RESTART',
     +       ' FOR UNSCALED ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING DODRC.')
 1080 FORMAT(' TEST USE OF TAUFAC TO RESTRICT FIRST STEP',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH FINITE DIFFERENCE DERIVATIVES',
     +       ' USING DODRC.')
 1090 FORMAT(' TEST DETECTION OF QUESTIONABLE ANALYTIC DERIVATIVES',
     +       ' FOR OLS PROBLEM'/
     +       ' USING DODRC.')
 1100 FORMAT(' TEST DETECTION OF INCORRECT ANALYTIC DERIVATIVES',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING DODRC.')
 2200 FORMAT (' DATA SET REFERENCE: ', A80)
 3100 FORMAT
     +   (//' *** COMPARISON OF NEW RESULTS WITH',
     +      ' DOUBLE PRECISION CDC CYBER 205 RESULT ***'//
     +      '                         NORM OF BETA',
     +      '        SUM OF SQUARED WTD OBS ERRORS  INFO')
 3210 FORMAT
     +   (/A25/2D37.30,I6)
 3310 FORMAT
     +   (///' NEW STOPPING CONDITION AND EXPECTED STOPPING CONDITION',
     +       ' AGREE,'/
     +       ' BUT INDICATE CONVERGENCE WAS NOT ATTAINED.'/
     +       ' NO FURTHER COMPARISONS WILL BE MADE BETWEEN NEW AND',
     +       ' EXPECTED RESULTS.')
 3320 FORMAT
     +   (///' *** WARNING ***'//
     +       ' NEW RESULTS AND EXPECTED RESULTS DO NOT',
     +       ' AGREE TO WITHIN STOPPING TOLERANCE'/
     +       ' OF NEW RESULT.')
 3330 FORMAT
     +   (///' NEW RESULTS AND EXPECTED RESULTS',
     +       ' AGREE TO WITHIN STOPPING TOLERANCE'/
     +       ' OF NEW RESULTS.')
 3340 FORMAT
     +   (///' *** WARNING ***'//
     +       ' NEW STOPPING CONDITION AND EXPECTED STOPPING CONDITION',
     +       ' DO NOT AGREE.'/
     +       ' NO FURTHER COMPARISONS WILL BE MADE BETWEEN NEW AND',
     +       ' EXPECTED RESULTS.')
 3350 FORMAT
     +   (///' *** WARNING ***'//
     +       ' UNEXPECTED STOPPING CONDITION.'/
     +       ' PLEASE CONTACT PACKAGE AUTHORS.')
 4100 FORMAT
     +   (///
     +   '1*** WARNING ***'//
     +   ' RESULTS FROM ONE OR MORE OF THE TESTS DO NOT',
     +   ' AGREE WITH THE EXPECTED RESULTS'/
     +   ' (OBTAINED USING DOUBLE PRECISION VERSION OF ODRPACK',
     +   ' RUN ON CDC CYBER 205).'/
     +   ' INSTALLATION OF ODRPACK SHOULD NOT BE CONSIDERED',
     +   ' SUCCESSFUL'/
     +   ' UNLESS FURTHER EXAMINATION OF THE RESULTS FINDS',
     +   ' THE DISCREPANCY TO BE INSIGNIFICANT.')
 4200 FORMAT
     +   (///
     +   '1RESULTS FROM ALL OF THE TESTS',
     +   ' AGREE WITH THE EXPECTED RESULTS'/
     +   ' (OBTAINED USING DOUBLE PRECISION VERSION OF ODRPACK',
     +   ' RUN ON CDC CYBER 205).'/
     +   ' INSTALLATION OF ODRPACK CAN BE CONSIDERED SUCCESSFUL.')
*
      END
*DODRXD
      SUBROUTINE DODRXD
     +   (TITLE,N,M,NP,X,LDX,Y,BETA)
C***BEGIN PROLOGUE  DODRXD
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET UP DATA FOR ODRPACK EXERCISER
C***END PROLOGUE  DODRXD
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER, WHERE
C         MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED,
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED,
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED, AND
C       MAXSET IS THE NUMBER OF DIFFERENT DATA SETS AVAILABLE.
*
C...PARAMETERS
      INTEGER
     +    MAXN,MAXM,MAXNP,MAXSET
      PARAMETER
     +    (MAXN=50,MAXNP=10,MAXM=3,MAXSET=10)
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDX,M,N,NP
      CHARACTER TITLE*80
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(*),X(LDX,*),Y(*)
*
C...SCALARS IN COMMON
      INTEGER
     +   SETNO
*
C...LOCAL SCALARS
      INTEGER
     +   I,J,K
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   BDATA(MAXNP,MAXSET),XDATA(MAXN,MAXM,MAXSET),
     +   YDATA(MAXN,MAXSET)
      INTEGER
     +   MDATA(MAXSET),NDATA(MAXSET),NPDATA(MAXSET)
      CHARACTER TDATA(MAXSET)*80
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
*
C...DATA STATEMENTS
      DATA
     +   TDATA(1)
     +   /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1'/
      DATA
     +   NDATA(1),MDATA(1),NPDATA(1)
     +   /40,1,2/
      DATA
     +   (BDATA(K,1),K=1,2)
     +   /1.0D+0,1.0D+0/
      DATA
     +   YDATA(1,1),XDATA(1,1,1)
     +   /-0.119569795672791172D+1,-0.213701920211315155D-1/
      DATA
     +   YDATA(2,1),XDATA(2,1,1)
     +   /-0.128023349509594288D+1,0.494813247025012969D-1/
      DATA
     +   YDATA(3,1),XDATA(3,1,1)
     +   /-0.125270693343174591D+1,0.127889194935560226D+0/
      DATA
     +   YDATA(4,1),XDATA(4,1,1)
     +   /-0.996698267935287383D+0,0.128615394085645676D+0/
      DATA
     +   YDATA(5,1),XDATA(5,1,1)
     +   /-0.104681033065801934D+1,0.232544285655021667D+0/
      DATA
     +   YDATA(6,1),XDATA(6,1,1)
     +   /-0.146724952092847308D+1,0.268151108026504516D+0/
      DATA
     +   YDATA(7,1),XDATA(7,1,1)
     +   /-0.123366891873487528D+1,0.309041029810905456D+0/
      DATA
     +   YDATA(8,1),XDATA(8,1,1)
     +   /-0.165665097907185554D+1,0.405991539210081099D+0/
      DATA
     +   YDATA(9,1),XDATA(9,1,1)
     +   /-0.168476460930907119D+1,0.376611424833536147D+0/
      DATA
     +   YDATA(10,1),XDATA(10,1,1)
     +   /-0.198571971169224491D+1,0.475875890851020811D+0/
      DATA
     +   YDATA(11,1),XDATA(11,1,1)
     +   /-0.195691696638051344D+1,0.499246935397386550D+0/
      DATA
     +   YDATA(12,1),XDATA(12,1,1)
     +   /-0.211871342665769836D+1,0.536615037024021147D+0/
      DATA
     +   YDATA(13,1),XDATA(13,1,1)
     +   /-0.268642932558671020D+1,0.581830765902996060D+0/
      DATA
     +   YDATA(14,1),XDATA(14,1,1)
     +   /-0.281123260058024347D+1,0.684512710422277446D+0/
      DATA
     +   YDATA(15,1),XDATA(15,1,1)
     +   /-0.328704486581785920D+1,0.660219819694757458D+0/
      DATA
     +   YDATA(16,1),XDATA(16,1,1)
     +   /-0.423062993461887032D+1,0.766990323960781092D+0/
      DATA
     +   YDATA(17,1),XDATA(17,1,1)
     +   /-0.512043906552226903D+1,0.808270426690578456D+0/
      DATA
     +   YDATA(18,1),XDATA(18,1,1)
     +   /-0.731032616379005535D+1,0.897410020083189004D+0/
      DATA
     +   YDATA(19,1),XDATA(19,1,1)
     +   /-0.109002759485608993D+2,0.959199774116277687D+0/
      DATA
     +   YDATA(20,1),XDATA(20,1,1)
     +   /-0.251810238510370206D+2,0.914675474762916558D+0/
      DATA
     +   YDATA(21,1),XDATA(21,1,1)
     +   /0.100123028650879944D+3,0.997759691476821892D+0/
      DATA
     +   YDATA(22,1),XDATA(22,1,1)
     +   /0.168225085871915048D+2,0.107136870384216308D+1/
      DATA
     +   YDATA(23,1),XDATA(23,1,1)
     +   /0.894830510866913009D+1,0.108033321037888526D+1/
      DATA
     +   YDATA(24,1),XDATA(24,1,1)
     +   /0.645853815227747004D+1,0.116064198672771453D+1/
      DATA
     +   YDATA(25,1),XDATA(25,1,1)
     +   /0.498218564760117328D+1,0.119080889359116553D+1/
      DATA
     +   YDATA(26,1),XDATA(26,1,1)
     +   /0.382971664718710476D+1,0.129418875187635420D+1/
      DATA
     +   YDATA(27,1),XDATA(27,1,1)
     +   /0.344116492497344184D+1,0.135594148099422453D+1/
      DATA
     +   YDATA(28,1),XDATA(28,1,1)
     +   /0.276840496973858949D+1,0.135302808716893195D+1/
      DATA
     +   YDATA(29,1),XDATA(29,1,1)
     +   /0.259521665196956666D+1,0.137994666010141371D+1/
      DATA
     +   YDATA(30,1),XDATA(30,1,1)
     +   /0.205996022794557661D+1,0.147630019545555113D+1/
      DATA
     +   YDATA(31,1),XDATA(31,1,1)
     +   /0.197939614345337836D+1,0.153450708076357840D+1/
      DATA
     +   YDATA(32,1),XDATA(32,1,1)
     +   /0.156739340562905589D+1,0.152805351451039313D+1/
      DATA
     +   YDATA(33,1),XDATA(33,1,1)
     +   /0.159032057073028366D+1,0.157147316247224806D+1/
      DATA
     +   YDATA(34,1),XDATA(34,1,1)
     +   /0.173102268158937949D+1,0.166649596005678175D+1/
      DATA
     +   YDATA(35,1),XDATA(35,1,1)
     +   /0.155512561664824758D+1,0.166505665838718412D+1/
      DATA
     +   YDATA(36,1),XDATA(36,1,1)
     +   /0.149635994944133260D+1,0.175214128553867338D+1/
      DATA
     +   YDATA(37,1),XDATA(37,1,1)
     +   /0.147487601463073568D+1,0.180567992463707922D+1/
      DATA
     +   YDATA(38,1),XDATA(38,1,1)
     +   /0.117244575233306998D+1,0.184624404296278952D+1/
      DATA
     +   YDATA(39,1),XDATA(39,1,1)
     +   /0.910931336069172580D+0,0.195568727388978002D+1/
      DATA
     +   YDATA(40,1),XDATA(40,1,1)
     +   /0.126172980914513272D+1,0.199326394036412237D+1/
      DATA
     +   TDATA(2)
     +   /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2'/
      DATA
     +   NDATA(2),MDATA(2),NPDATA(2)
     +   /50,2,3/
      DATA
     +   (BDATA(K,2),K=1,3)
     +   /-1.0D+0,1.0D+0,1.0D+0/
      DATA
     +   YDATA(1,2),XDATA(1,1,2),XDATA(1,2,2)
     +   /0.680832777217942900D+0,
     +   0.625474598833994800D-1,0.110179064209783100D+0/
      DATA
     +   YDATA(2,2),XDATA(2,1,2),XDATA(2,2,2)
     +   /0.122183594595302200D+1,
     +   0.202500343620642400D+0,-0.196140862891327600D-1/
      DATA
     +   YDATA(3,2),XDATA(3,1,2),XDATA(3,2,2)
     +   /0.118958678734608200D+1,
     +   0.164943738599876500D+0,0.166514874750996600D+0/
      DATA
     +   YDATA(4,2),XDATA(4,1,2),XDATA(4,2,2)
     +   /0.146982623764094600D+1,
     +   0.304874137610506100D+0,0.612908688041490500D-2/
      DATA
     +   YDATA(5,2),XDATA(5,1,2),XDATA(5,2,2)
     +   /0.167775338189355300D+1,
     +   0.532727445580665100D+0,0.938248787552444600D-1/
      DATA
     +   YDATA(6,2),XDATA(6,1,2),XDATA(6,2,2)
     +   /0.202485721906026200D+1,
     +   0.508823707598910200D+0,0.499605775020505400D-2/
      DATA
     +   YDATA(7,2),XDATA(7,1,2),XDATA(7,2,2)
     +   /0.258912851935938800D+1,
     +   0.704227041878554000D+0,0.819354849092326200D-1/
      DATA
     +   YDATA(8,2),XDATA(8,1,2),XDATA(8,2,2)
     +   /0.366894203254154800D+1,
     +   0.592077736111512000D+0,0.127113960672389100D-1/
      DATA
     +   YDATA(9,2),XDATA(9,1,2),XDATA(9,2,2)
     +   /0.574609583351347300D+1,
     +   0.104940945646421600D+1,0.258095243658316100D-1/
      DATA
     +   YDATA(10,2),XDATA(10,1,2),XDATA(10,2,2)
     +   /0.127676424026489300D+2,0.979382517558619200D+0,
     +   0.124280755181027900D+0/
      DATA
     +   YDATA(11,2),XDATA(11,1,2),XDATA(11,2,2)
     +   /0.123473079693623100D+1,0.637870453165538700D-1,
     +   0.304856401137196400D+0/
      DATA
     +   YDATA(12,2),XDATA(12,1,2),XDATA(12,2,2)
     +   /0.142256120864082800D+1,0.176123312906025700D+0,
     +   0.262387028078896900D+0/
      DATA
     +   YDATA(13,2),XDATA(13,1,2),XDATA(13,2,2)
     +   /0.169889534013024700D+1,0.310965082300263000D+0,
     +   0.226430765474758800D+0/
      DATA
     +   YDATA(14,2),XDATA(14,1,2),XDATA(14,2,2)
     +   /0.173485577901204400D+1,0.311394269116782100D+0,
     +   0.271375840410281800D+0/
      DATA
     +   YDATA(15,2),XDATA(15,1,2),XDATA(15,2,2)
     +   /0.277761263972834600D+1,0.447076126190612500D+0,
     +   0.255000858902618300D+0/
      DATA
     +   YDATA(16,2),XDATA(16,1,2),XDATA(16,2,2)
     +   /0.339163324662617300D+1,0.384786230998211100D+0,
     +   0.154958003178364000D+0/
      DATA
     +   YDATA(17,2),XDATA(17,1,2),XDATA(17,2,2)
     +   /0.589615137312147500D+1,0.649093176450780500D+0,
     +   0.258301685463773200D+0/
      DATA
     +   YDATA(18,2),XDATA(18,1,2),XDATA(18,2,2)
     +   /0.124415625214576800D+2,0.685612005372525500D+0,
     +   0.107391260603228600D+0/
      DATA
     +   YDATA(19,2),XDATA(19,1,2),XDATA(19,2,2)
     +   /-0.498491739153861600D+2,0.968747139425088400D+0,
     +   0.151932526135740700D+0/
      DATA
     +   YDATA(20,2),XDATA(20,1,2),XDATA(20,2,2)
     +   /-0.832795509000618600D+1,0.869789367989532900D+0,
     +   0.625507500586400000D-1/
      DATA
     +   YDATA(21,2),XDATA(21,1,2),XDATA(21,2,2)
     +   /0.184934617774239900D+1,-0.465309930332736600D-2,
     +   0.546795662595375200D+0/
      DATA
     +   YDATA(22,2),XDATA(22,1,2),XDATA(22,2,2)
     +   /0.175192979176839200D+1,0.604753397196646000D-2,
     +   0.230905749473922700D+0/
      DATA
     +   YDATA(23,2),XDATA(23,1,2),XDATA(23,2,2)
     +   /0.253949381238535800D+1,0.239418809621756000D+0,
     +   0.190752069681170700D+0/
      DATA
     +   YDATA(24,2),XDATA(24,1,2),XDATA(24,2,2)
     +   /0.373500774928501700D+1,0.456662468911699800D+0,
     +   0.328870615170984400D+0/
      DATA
     +   YDATA(25,2),XDATA(25,1,2),XDATA(25,2,2)
     +   /0.548408128950331000D+1,0.371115320522079500D+0,
     +   0.439978556640660500D+0/
      DATA
     +   YDATA(26,2),XDATA(26,1,2),XDATA(26,2,2)
     +   /0.125256880521774300D+2,0.586442107042503000D+0,
     +   0.490689043752286700D+0/
      DATA
     +   YDATA(27,2),XDATA(27,1,2),XDATA(27,2,2)
     +   /-0.493587797164916600D+2,0.579796274973298000D+0,
     +   0.521860998203383100D+0/
      DATA
     +   YDATA(28,2),XDATA(28,1,2),XDATA(28,2,2)
     +   /-0.801158974965412700D+1,0.805008094903899900D+0,
     +   0.292283538955391600D+0/
      DATA
     +   YDATA(29,2),XDATA(29,1,2),XDATA(29,2,2)
     +   /-0.437399487061934100D+1,0.637242340835710000D+0,
     +   0.402261740352486000D+0/
      DATA
     +   YDATA(30,2),XDATA(30,1,2),XDATA(30,2,2)
     +   /-0.297800103425979600D+1,0.982132817936118700D+0,
     +   0.392546836419047000D+0/
      DATA
     +   YDATA(31,2),XDATA(31,1,2),XDATA(31,2,2)
     +   /0.271811057454661300D+1,-0.223515657121262700D-1,
     +   0.650479019708978800D+0/
      DATA
     +   YDATA(32,2),XDATA(32,1,2),XDATA(32,2,2)
     +   /0.377035865613392400D+1,0.136081427545033600D+0,
     +   0.753020101897661800D+0/
      DATA
     +   YDATA(33,2),XDATA(33,1,2),XDATA(33,2,2)
     +   /0.560111053917143100D+1,0.145367053019870600D+0,
     +   0.611153532003093100D+0/
      DATA
     +   YDATA(34,2),XDATA(34,1,2),XDATA(34,2,2)
     +   /0.128152376174926800D+2,0.308221919576435500D+0,
     +   0.455217283290423900D+0/
      DATA
     +   YDATA(35,2),XDATA(35,1,2),XDATA(35,2,2)
     +   /-0.498709177732467200D+2,0.432658769133528300D+0,
     +   0.678607663414113000D+0/
      DATA
     +   YDATA(36,2),XDATA(36,1,2),XDATA(36,2,2)
     +   /-0.815797696908314300D+1,0.477785501079980300D+0,
     +   0.536178207572157000D+0/
      DATA
     +   YDATA(37,2),XDATA(37,1,2),XDATA(37,2,2)
     +   /-0.440240491195158600D+1,0.727986827616619000D+0,
     +   0.668497920573493900D+0/
      DATA
     +   YDATA(38,2),XDATA(38,1,2),XDATA(38,2,2)
     +   /-0.276723957061767500D+1,0.745950385588265100D+0,
     +   0.786077589007263700D+0/
      DATA
     +   YDATA(39,2),XDATA(39,1,2),XDATA(39,2,2)
     +   /-0.223203667288734800D+1,0.732537503527113500D+0,
     +   0.582625164046828400D+0/
      DATA
     +   YDATA(40,2),XDATA(40,1,2),XDATA(40,2,2)
     +   /-0.169728270310622000D+1,0.967352361433846300D+0,
     +   0.460779396016832800D+0/
      DATA
     +   YDATA(41,2),XDATA(41,1,2),XDATA(41,2,2)
     +   /0.551015652153227000D+1,0.129761784310891100D-1,
     +   0.700009537931860000D+0/
      DATA
     +   YDATA(42,2),XDATA(42,1,2),XDATA(42,2,2)
     +   /0.128036180496215800D+2,0.170163243950629700D+0,
     +   0.853131830764348700D+0/
      DATA
     +   YDATA(43,2),XDATA(43,1,2),XDATA(43,2,2)
     +   /-0.498257683396339000D+2,0.162768461906274000D+0,
     +   0.865315129048175000D+0/
      DATA
     +   YDATA(44,2),XDATA(44,1,2),XDATA(44,2,2)
     +   /-0.877334550221761900D+1,0.222914807946165800D+0,
     +   0.797511758502094500D+0/
      DATA
     +   YDATA(45,2),XDATA(45,1,2),XDATA(45,2,2)
     +   /-0.453820192156867600D+1,0.402910095604624900D+0,
     +   0.761492958727023100D+0/
      DATA
     +   YDATA(46,2),XDATA(46,1,2),XDATA(46,2,2)
     +   /-0.297499315738677900D+1,0.233770812593443200D+0,
     +   0.896000095844223500D+0/
      DATA
     +   YDATA(47,2),XDATA(47,1,2),XDATA(47,2,2)
     +   /-0.212743255978538900D+1,0.646528693486914700D+0,
     +   0.968574333700755700D+0/
      DATA
     +   YDATA(48,2),XDATA(48,1,2),XDATA(48,2,2)
     +   /-0.209703205365401000D+1,0.802811658568969400D+0,
     +   0.904866450476711600D+0/
      DATA
     +   YDATA(49,2),XDATA(49,1,2),XDATA(49,2,2)
     +   /-0.155287292042086200D+1,0.837137859891222900D+0,
     +   0.835684424990021900D+0/
      DATA
     +   YDATA(50,2),XDATA(50,1,2),XDATA(50,2,2)
     +   /-0.161356673770480700D+1,0.103165980756526600D+1,
     +   0.793902191912346100D+0/
      DATA
     +   TDATA(3)
     +   /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3'/
      DATA
     +   NDATA(3),MDATA(3),NPDATA(3)
     +   /44,1,9/
      DATA
     +   (BDATA(K,3),K=1,9)
     +   /0.281887509408440189D-5,
     +   -0.231290549212363845D-2,0.583035555572801965D+1,
     +   0.000000000000000000D+0,0.406910776203121026D+8,
     +   0.138001105225000000D-2,0.596038513209999999D-1,
     +   0.670582099359999998D+1,0.106994410000000000D+10/
      DATA
     +   YDATA(1,3),XDATA(1,1,3)
     +   /0.988227696721327788D+0,0.25D-8/
      DATA
     +   YDATA(2,3),XDATA(2,1,3)
     +   /0.988268083998559958D+0,0.64D-8/
      DATA
     +   YDATA(3,3),XDATA(3,1,3)
     +   /0.988341022958438831D+0,1.0D-8/
      DATA
     +   YDATA(4,3),XDATA(4,1,3)
     +   /0.988380557606306446D+0,0.9D-7/
      DATA
     +   YDATA(5,3),XDATA(5,1,3)
     +   /0.988275062411751338D+0,1.0D-6/
      DATA
     +   YDATA(6,3),XDATA(6,1,3)
     +   /0.988326680176446987D+0,0.4D-5/
      DATA
     +   YDATA(7,3),XDATA(7,1,3)
     +   /0.988306058860433439D+0,0.9D-5/
      DATA
     +   YDATA(8,3),XDATA(8,1,3)
     +   /0.988292880079125555D+0,0.16D-4/
      DATA
     +   YDATA(9,3),XDATA(9,1,3)
     +   /0.988305279259496905D+0,0.36D-4/
      DATA
     +   YDATA(10,3),XDATA(10,1,3)
     +   /0.988278142019574202D+0,0.64D-4/
      DATA
     +   YDATA(11,3),XDATA(11,1,3)
     +   /0.988224953369819946D+0,1.0D-4/
      DATA
     +   YDATA(12,3),XDATA(12,1,3)
     +   /0.988111989169778223D+0,0.144D-3/
      DATA
     +   YDATA(13,3),XDATA(13,1,3)
     +   /0.988045627103840613D+0,0.225D-3/
      DATA
     +   YDATA(14,3),XDATA(14,1,3)
     +   /0.987913715667047655D+0,0.400D-3/
      DATA
     +   YDATA(15,3),XDATA(15,1,3)
     +   /0.987841994238525678D+0,0.625D-3/
      DATA
     +   YDATA(16,3),XDATA(16,1,3)
     +   /0.987638450432434270D+0,0.900D-3/
      DATA
     +   YDATA(17,3),XDATA(17,1,3)
     +   /0.987587364331771395D+0,0.1225D-2/
      DATA
     +   YDATA(18,3),XDATA(18,1,3)
     +   /0.987576264149633684D+0,0.1600D-2/
      DATA
     +   YDATA(19,3),XDATA(19,1,3)
     +   /0.987539209110983643D+0,0.2025D-2/
      DATA
     +   YDATA(20,3),XDATA(20,1,3)
     +   /0.987621143807705698D+0,0.25D-2/
      DATA
     +   YDATA(21,3),XDATA(21,1,3)
     +   /0.988023229785526217D+0,0.36D-2/
      DATA
     +   YDATA(22,3),XDATA(22,1,3)
     +   /0.988558376710994197D+0,0.49D-2/
      DATA
     +   YDATA(23,3),XDATA(23,1,3)
     +   /0.989304775352439885D+0,0.64D-2/
      DATA
     +   YDATA(24,3),XDATA(24,1,3)
     +   /0.990210452265710472D+0,0.81D-2/
      DATA
     +   YDATA(25,3),XDATA(25,1,3)
     +   /0.991095950592263900D+0,1.00D-2/
      DATA
     +   YDATA(26,3),XDATA(26,1,3)
     +   /0.991475677297119272D+0,0.11025D-1/
      DATA
     +   YDATA(27,3),XDATA(27,1,3)
     +   /0.991901306250746771D+0,0.12100D-1/
      DATA
     +   YDATA(28,3),XDATA(28,1,3)
     +   /0.992619222425303263D+0,0.14400D-1/
      DATA
     +   YDATA(29,3),XDATA(29,1,3)
     +   /0.993617037631973475D+0,0.16900D-1/
      DATA
     +   YDATA(30,3),XDATA(30,1,3)
     +   /0.994727321698030676D+0,0.19600D-1/
      DATA
     +   YDATA(31,3),XDATA(31,1,3)
     +   /0.996523114720326189D+0,0.25600D-1/
      DATA
     +   YDATA(32,3),XDATA(32,1,3)
     +   /0.998036909563764020D+0,0.32400D-1/
      DATA
     +   YDATA(33,3),XDATA(33,1,3)
     +   /0.999151968626971372D+0,0.40000D-1/
      DATA
     +   YDATA(34,3),XDATA(34,1,3)
     +   /0.100017083706131769D+1,0.50625D-1/
      DATA
     +   YDATA(35,3),XDATA(35,1,3)
     +   /0.100110046382923523D+1,0.75625D-1/
      DATA
     +   YDATA(36,3),XDATA(36,1,3)
     +   /0.100059103180404652D+1,0.12250D+0/
      DATA
     +   YDATA(37,3),XDATA(37,1,3)
     +   /0.999211829791257561D+0,0.16000D+0/
      DATA
     +   YDATA(38,3),XDATA(38,1,3)
     +   /0.994711451526761862D+0,0.25000D+0/
      DATA
     +   YDATA(39,3),XDATA(39,1,3)
     +   /0.989844132928847109D+0,0.33640D+0/
      DATA
     +   YDATA(40,3),XDATA(40,1,3)
     +   /0.987234104554490439D+0,0.38440D+0/
      DATA
     +   YDATA(41,3),XDATA(41,1,3)
     +   /0.980928240178404887D+0,0.49D+0/
      DATA
     +   YDATA(42,3),XDATA(42,1,3)
     +   /0.970888680366055576D+0,0.64D+0/
      DATA
     +   YDATA(43,3),XDATA(43,1,3)
     +   /0.960043769857327398D+0,0.81D+0/
      DATA
     +   YDATA(44,3),XDATA(44,1,3)
     +   /0.947277159259551068D+0,1.00D+0/
      DATA
     +   TDATA(4)
     +   /' HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188'/
      DATA
     +   NDATA(4),MDATA(4),NPDATA(4)
     +   /13,2,3/
      DATA
     +   (BDATA(K,4),K=1,3)
     +   /3.0D+0,3.0D+0,-0.5D+0/
      DATA
     +   YDATA(1,4),XDATA(1,1,4),XDATA(1,2,4)
     +   /2.93D+0,0.0D+0,0.0D+0/
      DATA
     +   YDATA(2,4),XDATA(2,1,4),XDATA(2,2,4)
     +   /1.95D+0,0.0D+0,1.0D+0/
      DATA
     +   YDATA(3,4),XDATA(3,1,4),XDATA(3,2,4)
     +   /0.81D+0,0.0D+0,2.0D+0/
      DATA
     +   YDATA(4,4),XDATA(4,1,4),XDATA(4,2,4)
     +   /0.58D+0,0.0D+0,3.0D+0/
      DATA
     +   YDATA(5,4),XDATA(5,1,4),XDATA(5,2,4)
     +   /5.90D+0,1.0D+0,0.0D+0/
      DATA
     +   YDATA(6,4),XDATA(6,1,4),XDATA(6,2,4)
     +   /4.74D+0,1.0D+0,1.0D+0/
      DATA
     +   YDATA(7,4),XDATA(7,1,4),XDATA(7,2,4)
     +   /4.18D+0,1.0D+0,2.0D+0/
      DATA
     +   YDATA(8,4),XDATA(8,1,4),XDATA(8,2,4)
     +   /4.05D+0,1.0D+0,2.0D+0/
      DATA
     +   YDATA(9,4),XDATA(9,1,4),XDATA(9,2,4)
     +   /9.03D+0,2.0D+0,0.0D+0/
      DATA
     +   YDATA(10,4),XDATA(10,1,4),XDATA(10,2,4)
     +   /7.85D+0,2.0D+0,1.0D+0/
      DATA
     +   YDATA(11,4),XDATA(11,1,4),XDATA(11,2,4)
     +   /7.22D+0,2.0D+0,2.0D+0/
      DATA
     +   YDATA(12,4),XDATA(12,1,4),XDATA(12,2,4)
     +   /8.50D+0,2.5D+0,2.0D+0/
      DATA
     +   YDATA(13,4),XDATA(13,1,4),XDATA(13,2,4)
     +   /9.81D+0,2.9D+0,1.8D+0/
      DATA
     +   TDATA(5)
     +   /' DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522'/
      DATA
     +   NDATA(5),MDATA(5),NPDATA(5)
     +   /8,2,2/
      DATA
     +   (BDATA(K,5),K=1,2)
     +   /0.01155D+0,5000.0D+0/
      DATA
     +   YDATA(1,5),XDATA(1,1,5),XDATA(1,2,5)
     +   /0.912D+0,109.0D+0,600.0D+0/
      DATA
     +   YDATA(2,5),XDATA(2,1,5),XDATA(2,2,5)
     +   /0.382D+0,65.0D+0,640.0D+0/
      DATA
     +   YDATA(3,5),XDATA(3,1,5),XDATA(3,2,5)
     +   /0.397D+0,1180.0D+0,600.0D+0/
      DATA
     +   YDATA(4,5),XDATA(4,1,5),XDATA(4,2,5)
     +   /0.376D+0,66.0D+0,640.0D+0/
      DATA
     +   YDATA(5,5),XDATA(5,1,5),XDATA(5,2,5)
     +   /0.342D+0,1270.0D+0,600.0D+0/
      DATA
     +   YDATA(6,5),XDATA(6,1,5),XDATA(6,2,5)
     +   /0.358D+0,69.0D+0,640.0D+0/
      DATA
     +   YDATA(7,5),XDATA(7,1,5),XDATA(7,2,5)
     +   /0.348D+0,1230.0D+0,600.0D+0/
      DATA
     +   YDATA(8,5),XDATA(8,1,5),XDATA(8,2,5)
     +   /0.376D+0,68.0D+0,640.0D+0/
      DATA
     +   TDATA(6)
     +   /' POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGES 153-154'/
      DATA
     +   NDATA(6),MDATA(6),NPDATA(6)
     +   /14,1,3/
      DATA
     +   (BDATA(K,6),K=1,3)
     +   /25.0D+0,30.0D+0,6.0D+0/
      DATA
     +   YDATA(1,6),XDATA(1,1,6)
     +   /26.38D+0,1.0D+0/
      DATA
     +   YDATA(2,6),XDATA(2,1,6)
     +   /25.79D+0,2.0D+0/
      DATA
     +   YDATA(3,6),XDATA(3,1,6)
     +   /25.29D+0,3.0D+0/
      DATA
     +   YDATA(4,6),XDATA(4,1,6)
     +   /24.86D+0,4.0D+0/
      DATA
     +   YDATA(5,6),XDATA(5,1,6)
     +   /24.46D+0,5.0D+0/
      DATA
     +   YDATA(6,6),XDATA(6,1,6)
     +   /24.10D+0,6.0D+0/
      DATA
     +   YDATA(7,6),XDATA(7,1,6)
     +   /23.78D+0,7.0D+0/
      DATA
     +   YDATA(8,6),XDATA(8,1,6)
     +   /23.50D+0,8.0D+0/
      DATA
     +   YDATA(9,6),XDATA(9,1,6)
     +   /23.24D+0,9.0D+0/
      DATA
     +   YDATA(10,6),XDATA(10,1,6)
     +   /23.00D+0,10.0D+0/
      DATA
     +   YDATA(11,6),XDATA(11,1,6)
     +   /22.78D+0,11.0D+0/
      DATA
     +   YDATA(12,6),XDATA(12,1,6)
     +   /22.58D+0,12.0D+0/
      DATA
     +   YDATA(13,6),XDATA(13,1,6)
     +   /22.39D+0,13.0D+0/
      DATA
     +   YDATA(14,6),XDATA(14,1,6)
     +   /22.22D+0,14.0D+0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BDATA(MAXNP,MAXSET)
C        THE FUNCTION PARAMETER DATA SETS.
C     DOUBLE PRECISION BETA(*)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MDATA(MAXSET)
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE IN
C        EACH DATA SET.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDATA(MAXSET)
C        THE NUMBER OF OBSERVATIONS PER DATA SET.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPDATA(MAXSET)
C        THE NUMBER OF FUNCTION PARAMETERS IN EACH DATA SET.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     CHARACTER*80 TDATA(MAXSET)
C        THE REFERENCE FOR THE DATA SET BEING ANALYZED.
C     CHARACTER*80 TITLE
C        THE REFERENCE FOR THE DATA SET BEING ANALYZED.
C     DOUBLE PRECISION X(LDX,*)
C        THE ARRAY OF INDEPENDENT VARIABLES.
C     DOUBLE PRECISION XDATA(MAXN,MAXM,MAXSET)
C        THE ARRAY OF INDEPENDENT VARIABLES FOR EACH DATA SET.
C     DOUBLE PRECISION Y(*)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION YDATA(MAXN,MAXSET)
C        THE DEPENDENT VARIABLES FOR EACH DATA SET.
*
*
C***FIRST EXECUTABLE STATEMENT  DODRXD
*
*
      TITLE = TDATA(SETNO)
*
      N = NDATA(SETNO)
      M = MDATA(SETNO)
      NP = NPDATA(SETNO)
*
      DO 10 I=1,N
         Y(I) = YDATA(I,SETNO)
   10 CONTINUE
*
      DO 30 J=1,M
         DO 20 I=1,N
            X(I,J) = XDATA(I,J,SETNO)
   20    CONTINUE
   30 CONTINUE
*
      DO 40 K=1,NP
         BETA(K) = BDATA(K,SETNO)
   40 CONTINUE
*
      RETURN
*
      END
*DODRXF
      SUBROUTINE DODRXF
     +   (N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
C***BEGIN PROLOGUE  DODRXF
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER
C             CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE FUNCTION VALUES FOR ODRPACK EXERCISER
C***END PROLOGUE  DODRXF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPF,LDXPD,M,N,NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),F(N),XPLUSD(LDXPD,M)
*
C...SCALARS IN COMMON
      INTEGER
     +   SETNO
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ONE,ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0D0,1.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHETHER THE
C        THE VALUES OF BETA AND XPLUSD ARE ACCEPTABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODRXF
*
*
      IF (SETNO.EQ.1) THEN
*
C  SETNO. 1:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1
*
         IF (BETA(1).LE.1.01D0) THEN
            DO 100 I=1,N
               F(I) = BETA(1)/(XPLUSD(I,1)-BETA(2))
  100       CONTINUE
            ISTOPF = 0
         ELSE
            ISTOPF = 1
         END IF
*
      ELSE IF (SETNO.EQ.2) THEN
*
C  SETNO. 2:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2
*
         DO 200 I=1,N
            F(I) = BETA(1)/(BETA(2)*XPLUSD(I,1)+BETA(3)*XPLUSD(I,2)-ONE)
  200    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.3) THEN
*
C  SETNO. 3:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3
*
         DO 310 I=1,N
            F(I) = ZERO
            DO 300 J=1,4
               F(I) = F(I) + BETA(J)/(XPLUSD(I,1)+BETA(J+5))
  300       CONTINUE
            F(I) = F(I) + BETA(5)
  310    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.4) THEN
*
C  SETNO. 4:  HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188
*
         DO 400 I = 1, N
            F(I) = BETA(1)*XPLUSD(I,1) +
     +             BETA(2)*EXP(BETA(3)*XPLUSD(I,2))
  400    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.5) THEN
*
C  SETNO. 5:  DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522
*
         DO 500 I=1,N
            F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
     +             EXP(-BETA(2)*(ONE/XPLUSD(I,2) - ONE/620.0D0)))
  500    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.6) THEN
*
C  SETNO. 6:  POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGE 153-154
*
         DO 600 I=1,N
            F(I) = BETA(1)*
     +             (ONE+BETA(3)*XPLUSD(I,1)/BETA(2))**(-ONE/BETA(3))
  600    CONTINUE
         ISTOPF = 0
      END IF
*
      RETURN
*
      END
*DODRXJ
      SUBROUTINE DODRXJ
     +   (N,NP,M,BETA,XPLUSD,LDXPD,
     +   FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOPJ)
C***BEGIN PROLOGUE  DODRXJ
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE JACOBIAN MATRICIES FOR ODRPACK EXERCISER
C***END PROLOGUE  DODRXJ
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPJ,LDFJB,LDFJX,LDXPD,M,N,NP
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),FJACB(LDFJB,NP),FJACX(LDFJX,M),
     +   XPLUSD(LDXPD,M)
*
C...SCALARS IN COMMON
      INTEGER
     +   SETNO
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   FAC1,FAC2,FAC3,FAC4,ONE,ZERO
      INTEGER
     +   I,K
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0D0,1.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION FAC1,FAC2,FAC3,FAC4
C        VARIOUS FACTORS AND TERMS USED IN COMPUTING THE JACOBIANS.
C     DOUBLE PRECISION FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     DOUBLE PRECISION FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO XPLUSD.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, USED TO DESIGNATE WHETHER THE
C        THE VALUES OF BETA AND XPLUSD ARE ACCEPTABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODRXJ
*
*
      IF (SETNO.EQ.1) THEN
*
C  SETNO. 1:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1
*
         DO 110 I=1,N
            FJACB(I,1) = ONE/(XPLUSD(I,1)-BETA(2))
            FJACB(I,2) = BETA(1)*(XPLUSD(I,1)-BETA(2))**(-2)
  110    CONTINUE
*
         IF (ISODR) THEN
            DO 120 I=1,N
               FJACX(I,1) = -BETA(1)*(XPLUSD(I,1)-BETA(2))**(-2)
  120       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.2) THEN
*
C  SETNO. 2:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2
*
         DO 200 I=1,N
            FJACB(I,1) = ONE/
     +                   (BETA(2)*XPLUSD(I,1)+BETA(3)*XPLUSD(I,2)-ONE)
            FJACB(I,2) = -BETA(1)*
     +                   ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                     XPLUSD(I,2)-ONE)**(-2))*
     +                   XPLUSD(I,1)
            FJACB(I,3) = -BETA(1)*
     +                   ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                     XPLUSD(I,2)-ONE)**(-2))*
     +                   XPLUSD(I,2)
  200    CONTINUE
*
         IF (ISODR) THEN
            DO 220 I=1,N
               FJACX(I,1) = -BETA(1)*
     +                      ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                        XPLUSD(I,2)-ONE)**(-2))*
     +                      BETA(2)
               FJACX(I,2) = -BETA(1)*
     +                      ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                        XPLUSD(I,2)-ONE)**(-2))*
     +                      BETA(3)
  220       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.3) THEN
*
C  SETNO. 3:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3
*
         DO 310 I=1,N
            FJACB(I,5) = ONE
            DO 300 K=1,4
               FJACB(I,K) = ONE/(XPLUSD(I,1)+BETA(K+5))
               FJACB(I,K+5) = -BETA(K)*(XPLUSD(I,1)+BETA(K+5))**(-2)
  300       CONTINUE
  310    CONTINUE
*
         IF (ISODR) THEN
            DO 330 I=1,N
               FJACX(I,1) = ZERO
               DO 320 K=4,1,-1
                  FJACX(I,1) = FJACX(I,1) -
     +                         BETA(K)*(XPLUSD(I,1)+BETA(K+5))**(-2)
  320          CONTINUE
  330       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.4) THEN
*
C  SETNO. 4:  HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188
*
         DO 410 I=1,N
            FJACB(I,1) = XPLUSD(I,1)
            FJACB(I,2) = EXP(BETA(3)*XPLUSD(I,2))
            FJACB(I,3) = BETA(2)*EXP(BETA(3)*XPLUSD(I,2))*XPLUSD(I,2)
  410    CONTINUE
*
         IF (ISODR) THEN
            DO 420 I=1,N
               FJACX(I,1) = BETA(1)
               FJACX(I,2) = BETA(2)*EXP(BETA(3)*XPLUSD(I,2))*BETA(3)
  420       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.5) THEN
*
C  SETNO. 5:  DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522
*
         DO 510 I=1,N
            FAC1 = ONE/XPLUSD(I,2) - ONE/620.0D0
            FAC2 = EXP(-BETA(2)*FAC1)
            FAC3 = BETA(1)*XPLUSD(I,1)
            FAC4 = EXP(-FAC3*FAC2)
*
            FJACB(I,1) = -FAC4*XPLUSD(I,1)*FAC2
            FJACB(I,2) = FAC4*FAC3*FAC2*FAC1
*
            IF (ISODR) THEN
               FJACX(I,1) = -FAC4*BETA(1)*FAC2
               FJACX(I,2) = -FAC4*FAC3*FAC2*BETA(2)/XPLUSD(I,2)**2
            END IF
  510    CONTINUE
*
      ELSE IF (SETNO.EQ.6) THEN
*
C  SETNO. 6:  POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGE 153-154
*
C             N.B.  THIS DERIVATIVE IS INTENTIONALLY CODED INCORRECTLY
*
         DO 610 I=1,N
            FJACB(I,1) = ZERO
            FJACB(I,2) = ZERO
            FJACB(I,3) = ZERO
*
            IF (ISODR) THEN
               FJACX(I,1) = XPLUSD(I,1)
            END IF
  610    CONTINUE
      END IF
*
      ISTOPJ = 0
*
      RETURN
*
      END
*DODRXW
      SUBROUTINE DODRXW
     +   (MAXN,MAXM,MAXNP,LIWMIN,LWMIN)
C***BEGIN PROLOGUE  DODRXW
C***DATE WRITTEN   890205   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE MINIMUM LENGTHS FOR WORK VECTORS
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  NONE
C***END PROLOGUE  DODRXW
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LIWMIN,LWMIN,MAXN,MAXM,MAXNP
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER LIWMIN
C        THE MINIMUM LENGTH OF VECTOR IWORK FOR A GIVEN PROBLEM.
C     INTEGER LWMIN
C        THE MINIMUM LENGTH OF VECTOR WORK FOR A GIVEN PROBLEM.
C     INTEGER MAXM
C        THE NUMBER OF COLUMNS IN THE INDEPENDENT VARIABLE.
C     INTEGER MAXN
C        THE NUMBER OF OBSERVATIONS.
C     INTEGER MAXNP
C        THE NUMBER OF FUNCTION PARAMETERS.
*
*
C***FIRST EXECUTABLE STATEMENT  DODRXW
*
*
      LIWMIN = 19 + 2*MAXNP + MAXM
      LWMIN = 17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP
*
      RETURN
      END
      PROGRAM SAMPLE
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER
C  WHERE  MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED
C          LDX IS THE LEADING DIMENSION OF ARRAY X
C         LDWD IS THE LEADING DIMENSION OF ARRAY WD
C        LWORK IS THE DIMENSION OF VECTOR WORK
C       LIWORK IS THE DIMENSION OF VECTOR IWORK
*
C...PARAMETERS
      INTEGER
     +   MAXN,MAXM,MAXNP,LDX,LDWD,LWORK,LIWORK
      PARAMETER
C    +   (MAXN=15,
     +   MAXM=5,
     +   MAXNP=5,
     +   LDX=MAXN,
     +   LDWD=1,
     +   LWORK = 17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
     +   LIWORK = 19 + 2*MAXNP + MAXM)
*
C  DECLARE USER-SUPPLIED SUBROUTINES AND
C  ALL OTHER NECESSARY VARIABLES AND ARRAYS
*
C...LOCAL SCALARS
      INTEGER
     +   I,INFO,IPRINT,J,JOB,LUNERR,LUNRPT,M,N,NP
*
C...LOCAL ARRAYS
      REAL
     +   BETA(MAXNP),WD(LDWD,MAXM),WORK(LWORK),
     +   X(LDX,MAXM),Y(LDX)
      INTEGER
     +   IWORK(LIWORK)
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SODR,FUN,JAC
*
*
      OPEN(UNIT=5,FILE='DATA1')
      OPEN(UNIT=6,FILE='REPORT')
*
C  READ NUMBER OF OBSERVATIONS
C       NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE
C       NUMBER OF PARAMETERS
C       OBSERVED VALUES OF INDEPENDENT AND DEPENDENT VARIABLES
C       STARTING VALUES OF FUNCTION PARAMETERS
*
      READ (5,*) N,M,NP
      READ (5,*) ((X(I,J),I=1,N),J=1,M)
      READ (5,*) (Y(I),I=1,N)
      READ (5,*) (BETA(I),I=1,NP)
*
C  SPECIFY DELTA WEIGHTS
*
      WD(1,1) = 3.0E0
      WD(1,2) = 5.0E0
*
C  SET CONTROL VALUES TO INVOKE DEFAULT SETTING
*
      JOB = -1
      IPRINT = -1
      LUNERR = -1
      LUNRPT = -1
*
C  COMPUTE ODR SOLUTION USING FINITE-DIFFERENCE DERIVATIVES
*
      CALL SODR
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,
     +   Y,
     +   BETA,
     +   WD,LDWD,
     +   JOB,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
*
      END
      SUBROUTINE FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
*
C  INPUT ARGUMENTS
C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
C     INTEGER N,NP,M,LDXPD
C     REAL BETA(NP),XPLUSD(LDXPD,M)
C  OUTPUT ARGUMENTS
C     REAL F(N)
C     INTEGER ISTOPF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPF,LDXPD,M,N,NP
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),F(N),XPLUSD(LDXPD,M)
*
C...LOCAL SCALARS
      INTEGER
     +   I
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
*
      DO 10 I = 1, N
         IF (XPLUSD(I,2).NE.0.0E0) THEN
            F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
     +             EXP(-BETA(2)*
     +                  (1.0E0/XPLUSD(I,2) - 1.0E0/620.0E0)))
         ELSE
            ISTOPF = 1
            RETURN
         END IF
   10 CONTINUE
      ISTOPF = 0
*
      RETURN
      END
      PROGRAM SAMPLE
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER
C  WHERE  MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED
C          LDX IS THE LEADING DIMENSION OF ARRAY X
C       LDSCLD IS THE LEADING DIMENSION OF ARRAY SCLD
C         LDWD IS THE LEADING DIMENSION OF ARRAY WD
C        LDIFX IS THE LEADING DIMENSION OF ARRAY IFIXX
C        LWORK IS THE DIMENSION OF VECTOR WORK
C       LIWORK IS THE DIMENSION OF VECTOR IWORK
*
C...PARAMETERS
      INTEGER
     +   MAXN,MAXM,MAXNP,LDSCLD,LDIFX,LDWD,LWORK,LIWORK
      PARAMETER
C    +   (MAXN=15,
     +   MAXM=5,
     +   MAXNP=5,
     +   LDSCLD=1,
     +   LDWD=1,
     +   LDIFX=1,
     +   LWORK=17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
     +   LIWORK=19 + 2*MAXNP + MAXM)
*
C  DECLARE USER-SUPPLIED SUBROUTINES AND
C  ALL OTHER NECESSARY VARIABLES AND ARRAYS
*
C...LOCAL SCALARS
      REAL
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   I,INFO,IPRINT,J,JOB,LDX,LUNERR,LUNRPT,M,MAXIT,N,NDIGIT,NP
*
C...LOCAL ARRAYS
      REAL
     +   BETA(MAXNP),WD(LDWD,MAXM),SCLB(MAXNP),
     +   SCLD(LDSCLD,MAXM),W(MAXN),WORK(LWORK),X(MAXN,MAXM),Y(MAXN)
      INTEGER
     +   IFIXB(MAXNP),IFIXX(LDIFX,MAXM),IWORK(LIWORK)
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SODRC,FUN,JAC
*
*
      OPEN(UNIT=5,FILE='DATA1')
      OPEN(UNIT=6,FILE='REPORT')
*
C  SPECIFY LEADING DIMENSION OF ARRAY X
*
      LDX = MAXN
*
C  READ NUMBER OF OBSERVATIONS
C       NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE
C       NUMBER OF PARAMETERS
C       OBSERVED VALUES OF INDEPENDENT AND DEPENDENT VARIABLES
C       STARTING VALUES OF FUNCTION PARAMETERS
*
      READ (5,*) N,M,NP
      READ (5,*) ((X(I,J),I=1,N),J=1,M)
      READ (5,*) (Y(I),I=1,N)
      READ (5,*) (BETA(I),I=1,NP)
*
C  FIX SECOND COLUMN OF INDEPENDENT VARIABLE AT OBSERVED VALUES
*
      IFIXX(1,1) = 1
      IFIXX(1,2) = 0
*
C  SPECIFY USE OF DEFAULT SCALING
*
      SCLD(1,1) = -1.0E0
      SCLB(1) = -1.0E0
*
C  INDICATE ALL BETA'S ARE TO BE ESTIMATED
*
      IFIXB(1) = -1
*
C  SPECIFY WEIGHTS
*
      WD(1,1) = 3.0E0
      WD(1,2) = 5.0E0
      W(1) = -1.0E0
*
C  SET CONTROL VALUES AND STOPPING CRITERIA
*
      JOB = 10
      NDIGIT = -1
      TAUFAC = -1.0E0
      SSTOL = -1.0E0
      PARTOL = -1.0E0
      MAXIT = -1
      IPRINT = 1111
      LUNERR = -1
      LUNRPT = -1
*
C  COMPUTE ODR SOLUTION USING USER-SUPPLIED ANALYTIC DERIVATIVES
*
      CALL SODRC
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   Y,
     +   BETA,IFIXB,SCLB,
     +   WD,LDWD,W,
     +   JOB,NDIGIT,TAUFAC,
     +   SSTOL,PARTOL,MAXIT,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
*
      END
      SUBROUTINE FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
*
C  INPUT ARGUMENTS
C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
*
C     INTEGER N,NP,M,LDXPD
C     REAL BETA(NP),XPLUSD(LDXPD,M)
*
C  OUTPUT ARGUMENTS
*
C     REAL F(N)
C     INTEGER ISTOPF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPF,LDXPD,M,N,NP
*
C...ARRAY ARGUMENTS
      REAL
     +    BETA(NP),F(N),XPLUSD(LDXPD,M)
*
C...LOCAL SCALARS
      INTEGER
     +    I
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +    EXP
*
*
      DO 10 I = 1, N
         IF (XPLUSD(I,2).NE.0.0E0) THEN
            F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
     +             EXP(-BETA(2)*
     +                  (1.0E0/XPLUSD(I,2) - 1.0E0/620.0E0)))
         ELSE
            ISTOPF = 1
            RETURN
         END IF
   10 CONTINUE
      ISTOPF = 0
*
      RETURN
      END
      SUBROUTINE JAC(N,NP,M,BETA,XPLUSD,LDXPD,
     +               FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOPJ)
*
C  INPUT ARGUMENTS
C  (WHICH MUST NOT BE CHANGED BY THIS ROUTINE)
*
C     INTEGER N,NP,M,LDXPD
C     REAL BETA(NP),XPLUSD(LDXPD,M)
C     LOGICAL ISODR
*
C  OUTPUT ARGUMENTS
*
C     REAL FJACB(LDFJB,NP),FJACX(LDFJX,M)
C     INTEGER ISTOPJ
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPJ,LDFJB,LDFJX,LDXPD,M,N,NP
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),FJACB(LDFJB,NP),FJACX(LDFJX,M),XPLUSD(LDXPD,M)
*
C...LOCAL SCALARS
      REAL
     +   FAC1,FAC2,FAC3,FAC4
      INTEGER
     +   I
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
*
      DO 10 I=1,N
         FAC1 = 1.0E0/XPLUSD(I,2) - 1.0E0/620.0E0
         FAC2 = EXP(-BETA(2)*FAC1)
         FAC3 = BETA(1)*XPLUSD(I,1)
         FAC4 = EXP(-FAC3*FAC2)
*
         FJACB(I,1) = -FAC4*XPLUSD(I,1)*FAC2
         FJACB(I,2) = FAC4*FAC3*FAC2*FAC1
*
         IF (ISODR) THEN
            FJACX(I,1) = -FAC4*BETA(1)*FAC2
            FJACX(I,2) = -FAC4*FAC3*FAC2*BETA(2)/XPLUSD(I,2)**2
         END IF
   10 CONTINUE
      ISTOPJ = 0
*
      RETURN
      END
*STEST
      PROGRAM STEST
C***BEGIN PROLOGUE  TEST
C***REFER TO SODR,SODRC
C***ROUTINES CALLED  SODRX
C***DATE WRITTEN   861229   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  EXERCISE FEATURES OF ODRPACK SOFTWARE
C***END PROLOGUE  ODRPACK
*
C...SCALARS IN COMMON
      INTEGER
     +   NTEST
*
C...LOCAL SCALARS
      REAL
     +   TSTFAC
      INTEGER
     +   LUNERR,LUNRPT,LUNSUM
      LOGICAL
     +   PASSED
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SODRX
*
C...COMMON BLOCKS
      COMMON /TSTSET/ NTEST
*
C***VARIABLE DECLARATIONS (ALPHABETICALLY)
*
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNSUM
C        THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT THAT LISTS
C        ONLY THE TEST COMPARISONS AND NOT THE ODRPACK GENERATED
C        REPORTS.
C     INTEGER NTEST
C        THE NUMBER OF TESTS TO BE RUN.
C     LOGICAL PASSED
C        THE INDICATOR VALUE USED TO DESIGNATES WHETHER THE RESULTS OF
C        ALL OF THE TESTS AGREE WITH THOSE FROM THE CDC CYBER 205 USING
C        DOUBLE PRECISION (PASSED=TRUE), OR WHETHER SOME OF THE RESULTS
C        DISAGREED (PASSED=FALSE).
C     REAL TSTFAC
C        THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES USED
C        TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND RESULTS
C        OBTAINED USING DOUBLE PRECISION VERSION ON CDC CYBER 205.
C        VALUES OF TSTFAC GREATER THAN ONE INCREASE THE TEST TOLERANCES,
C        MAKING THE TESTS EASIER TO PASS AND ALLOWING SMALL
C        DISCREPANCIES BETWEEN THE COMPUTED AND EXPECTED RESULTS TO BE
C        AUTOMATICALLY DISCOUNTED.
*
*
C***FIRST EXECUTABLE STATEMENT  TEST
*
*
C  SET UP NECESSARY FILES
*
C  NOTE:  ODRPACK GENERATES COMPUTATION AND ERROR REPORTS ON
C         LOGICAL UNIT 6 BY DEFAULT;
C         LOGICAL UNIT 'LUNSUM' USED TO SUMMARIZE RESULTS OF COMPARISONS
C         FROM EXERCISE ROUTINE SODRX.
*
      LUNRPT = 18
      LUNERR = 18
      LUNSUM = 19
*
      OPEN(UNIT=LUNRPT,FILE='REPORT')
      OPEN(UNIT=LUNERR,FILE='REPORT')
      OPEN(UNIT=LUNSUM,FILE='SUMMARY')
*
C  EXERCISE SINGLE PRECISION VERSION OF ODRPACK
C  (TEST REPORTS GENERATED ON FILE 'RESULTS' AND
C   SUMMARIZED IN FILE 'SUMMARY')
*
      NTEST = 10
      TSTFAC = 1.0E0
      CALL SODRX(TSTFAC,PASSED,LUNSUM)
*
      END
*SODRX
      SUBROUTINE SODRX
     +   (TSTFAC,PASSED,LUNSUM)
C***BEGIN PROLOGUE  SODRX
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  EXERCISE FEATURES OF ODRPACK SOFTWARE
C***DESCRIPTION
C     SODRX SUBPROGRAM ARGUMENTS:
C     REAL TSTFAC
C        THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES USED
C        TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND RESULTS
C        OBTAINED USING DOUBLE PRECISION VERSION ON CDC CYBER 205.
C        VALUES OF TSTFAC GREATER THAN ONE INCREASE THE TEST TOLERANCES,
C        MAKING THE TESTS EASIER TO PASS AND ALLOWING SMALL
C        DISCREPANCIES BETWEEN THE COMPUTED AND EXPECTED RESULTS TO BE
C        AUTOMATICALLY DISCOUNTED.
C     LOGICAL PASSED
C        THE INDICATOR VALUE USED TO DESIGNATES WHETHER THE RESULTS OF
C        ALL OF THE TESTS AGREE WITH THOSE FROM THE CDC CYBER 205 USING
C        DOUBLE PRECISION (PASSED=TRUE), OR WHETHER SOME OF THE RESULTS
C        DISAGREED (PASSED=FALSE).
C     INTEGER LUNSUM
C        THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT THAT LISTS
C        ONLY THE TEST COMPARISONS AND NOT THE ODRPACK GENERATED
C        REPORTS, WHICH ARE WRITTEN TO UNIT 6.
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  SIWINF,SMPREC,SNRM2,SODR,SODRC,SODRXD,
C                    SODRXF,SODRXJ,SODRXW,SWINF,SZERO,
C***END PROLOGUE  SODRX
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER, WHERE
C       LIWORK IS THE LENGTH OF THE WORK VECTOR IWORK.
C        LWORK IS THE LENGTH OF THE WORK VECTOR WORK.
C         MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED,
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED,
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED, AND
C       NTESTS IS THE NUMBER OF DIFFERENT TESTS THAT CAN BE RUN.
*
C...PARAMETERS
      INTEGER
     +   LIWORK,LWORK,MAXN,MAXM,MAXNP,NTESTS
      PARAMETER
C    +   (MAXN=50, MAXNP=10, MAXM=3, NTESTS=10,
     +   LWORK = 17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP,
     +   LIWORK = 19 + 2*MAXNP + MAXM)
*
C...SCALAR ARGUMENTS
      REAL
     +   TSTFAC
      INTEGER
     +   LUNSUM
      LOGICAL
     +   PASSED
*
C...SCALARS IN COMMON
      INTEGER
     +   NTEST,SETNO
*
C...LOCAL SCALARS
      REAL
     +   BNRM,EPSMAC,HUNDRD,ONE,P01,P2,PARTOL,RSSQ,SSTOL,
     +   TAUFAC,TSTTOL,TWO,ZERO
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSI,EPSMAI,ETAI,FJACBI,FJACXI,FNI,FSI,I,IDFI,INFO,INT2I,
     +   IPRINI,IPRINT,IRANKI,ITEST,JOB,JOBI,JPVTI,L,LDIFX,LDSCLD,LDTTI,
     +   LDWD,LDX,LIWKMN,LIWMIN,LUN,LUNERI,LUNERR,LUNRPI,LUNRPT,LWKMN,
     +   LWMIN,M,MAXIT,MAXITI,MSG,MSGB,MSGX,N,NDIGIT,NETAI,NFEVI,NITERI,
     +   NJEVI,NNZWI,NP,NPPI,NROWI,NTOLI,OLMAVI,OMEGAI,PARTLI,PNORMI,
     +   PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,SEI,SI,SSFI,SSI,SSSI,
     +   SSTOLI,TAUFCI,TAUI,TI,TTI,UI,VCVI,WRK1I,WSSI,WSSDEI,WSSEPI,
     +   XPLUSI,YTI
      LOGICAL
     +   FAILED,FAILS,SHORT
      CHARACTER TITLE*80
*
C...LOCAL ARRAYS
      REAL
     +   BETA(MAXNP),DP205(2,NTESTS),
     +   SCLB(MAXNP),SCLD(MAXN,MAXM),W(MAXN),WD(MAXN,MAXM),WORK(LWORK),
     +   X(MAXN,MAXM),Y(MAXN)
      INTEGER
     +   IDP205(NTESTS),IFIXB(MAXNP),IFIXX(MAXN,MAXM),IWORK(LIWORK)
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SMPREC,SNRM2
      EXTERNAL
     +   SMPREC,SNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SIWINF,SODR,SODRC,SODRXD,SODRXF,SODRXJ,SODRXW,SWINF,SZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MOD
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
      COMMON /TSTSET/ NTEST
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P01,P2,ONE,TWO,HUNDRD
     +   /0.0E0,0.01E0,0.2E0,1.0E0,2.0E0,100.0E0/
*
      DATA
     +   (DP205(I,1),I=1,2)
     +   /0.276273319578025680897844934084E+05,
     +    0.753263956902291894369510458488E-03/
      DATA
     +   (DP205(I,2),I=1,2)
     +   /0.276273263014367271057285851346E+05,
     +    0.753846772268713150687427932817E-03/
      DATA
     +   (DP205(I,3),I=1,2)
     +   /0.106994410000000002794090519414E+10,
     +    0.121280859325605635962966065824E-04/
      DATA
     +   (DP205(I,4),I=1,2)
     +   /0.106994410000000002662346114304E+10,
     +    0.545208463379060601757201499747E-06/
      DATA
     +   (DP205(I,5),I=1,2)
     +   /0.142698815637725861752157173592E+01,
     +    0.108472868712743221975390382045E+01/
      DATA
     +   (DP205(I,6),I=1,2)
     +   /0.426132182951397887187250887403E+01,
     +    0.147796721039842073356542433095E-01/
      DATA
     +   (DP205(I,7),I=1,2)
     +   /0.426127230714288607663880633106E+01,
     +    0.147796612546537433680413855128E-01/
      DATA
     +   (DP205(I,8),I=1,2)
     +   /0.437148731790976277721640707488E+02,
     +    0.114441947440828606711224215902E-02/
      DATA
     +   (DP205(I,9),I=1,2)
     +   /0.395094925302768220710923336357E+02,
     +    0.665183875083491081963688151467E+02/
      DATA
     +   (DP205(I,10),I=1,2)
     +   /0.395094925302768220710923336357E+02,
     +    0.665183875083491081963688151467E+02/
*
      DATA
     +   (IDP205(I),I=1,10)
     +   /1,1,1,1,101,4,1,1,1023,40100/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL SODRXF
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL SODRXJ
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     REAL BETA(MAXNP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     REAL BNRM
C        THE NORM OF THE BETA.
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     REAL DP205(2,NTESTS)
C         THE FLOATING POINT RESULTS FROM A CDC CYBER 205 USING
C         DOUBLE PRECISION.
C     INTEGER EPSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     LOGICAL FAILED
C        THE INDICATOR VALUE USED TO DESIGNATE WHETHER THE RESULTS OF
C        ALL OF THE DEMONSTRATION RUNS AGREED WITH THOSE FROM THE
C        CDC CYBER 205 USING DOUBLE PRECISION (FAILED=FALSE) OR WHETHER
C        SOME OF THE TESTS DISAGREED (FAILED=TRUE).
C     LOGICAL FAILS
C        THE INDICATOR VALUE USED TO DESIGNATE WHETHER THE RESULTS OF
C        AN INDIVIDUAL DEMONSTRATION RUN AGREED WITH THOSE FROM THE
C        CDC CYBER 205 USING DOUBLE PRECISION (FAILS=FALSE) OR DISAGREE
C        (FAILS=TRUE).
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     REAL HUNDRD
C        THE VALUE 100.0E0.
C     INTEGER I
C        AN INDEX VARIABLE.
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IDP205(NTESTS)
C         THE INTEGER RESULTS FROM A CDC CYBER 205 USING
C         DOUBLE PRECISION.
C     INTEGER IFIXB(MAXNP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(MAXN,MAXM)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER ITEST
C        THE NUMBER OF THE CURRENT TEST BEING RUN.
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LIWMIN
C        THE MINIMUM LENGTH OF VECTOR IWORK FOR A GIVEN PROBLEM.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUN
C        THE LOGICAL UNIT NUMBER CURRENTLY BEING USED.
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNSUM
C        THE LOGICAL UNIT NUMBER USED FOR A SUMMARY REPORT.
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWMIN
C        THE MINIMUM LENGTH OF VECTOR WORK FOR A GIVEN PROBLEM.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSG
C        AN INDICATOR VARIABLE USED TO DESIGNATE WHICH MESSAGE IS
C        TO BE PRINTED AS A RESULT OF THE COMPARISON WITH THE CDC CYBER
C        205 RESULTS.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTEST
C        THE NUMBER OF TESTS TO BE RUN.
C     INTEGER NTESTS
C        THE NUMBER OF DIFFERENT TESTS AVAILABLE.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY SJCK.
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     REAL ONE
C        THE VALUE 1.0E0.
C     LOGICAL PASSED
C        THE INDICATOR VALUE USED TO DESIGNATES WHETHER THE RESULTS OF
C        ALL OF THE DEMONSTRATION RUNS AGREED WITH THOSE FROM THE
C        CDC CYBER 205 USING DOUBLE PRECISION (PASSED=TRUE), OR WHETHER
C        SOME OF THE RESULTS DISAGREED (PASSED=FALSE).
C     REAL P01
C        THE VALUE 0.01E0.
C     REAL P2
C        THE VALUE 0.2E0.
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     REAL RSSQ
C        THE NORM OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE.
C     REAL SCLB(MAXNP)
C        THE SCALE VALUE FOR EACH VALUE OF BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(MAXN,MAXM)
C        THE SCALE VALUE FOR EACH VALUE OF DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STANDARD ERRORS FOR THE PARAMETERS, ALSO USED AS A
C        WORK ARRAY.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER ODRPACK IS TO
C        BE INVOKED BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-CALL
C        (SHORT=.FALSE.).
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     CHARACTER*80 TITLE
C        THE REFERENCE FOR THE DATA SET BEING ANALYZED.
C     REAL TSTFAC
C        THE USER-SUPPLIED FACTOR FOR SCALING THE TEST TOLERANCES
C        USED TO CHECK FOR AGREEMENT BETWEEN COMPUTED RESULTS AND
C        RESULTS OBTAINED USING DOUBLE PRECISION VERSION ON CDC
C        CYBER 205.
C     REAL TSTTOL
C        THE TEST TOLERANCE USED IN CHECKING COMPUTED VALUES FOR
C        PURPOSES OF DETERMINING PROPER INSTALLATION.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     REAL TWO
C          THE VALUE 2.0E0.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     INTEGER VCVI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE VARIANCE COVARIANCE MATRIX, ALSO USED
C        TO STORE THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     REAL W(MAXN)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(MAXN,MAXM)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WORK(LWORK)
C        THE REAL WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     REAL X(MAXN,MAXM)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     REAL Y(MAXN)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER YTI
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODRX
*
*
C  SET LOGICAL UNITS FOR ERROR AND COMPUTATION REPORTS
*
      LUNERR = 18
      LUNRPT = 18
*
C  INITIALIZE TEST TOLERANCE
*
      IF (TSTFAC.GT.ONE) THEN
         TSTTOL = TSTFAC
      ELSE
         TSTTOL = ONE
      END IF
*
C  INITIALIZE MACHINE PRECISION
*
      EPSMAC = SMPREC()
*
C  INITIALIZE LEADING DIMENSION OF X
*
      LDX = MAXN
*
C  INITIALIZE MISCELLANEOUS VARIABLES USED IN THE EXERCISE PROCEDURE
*
      FAILED = .FALSE.
      SHORT = .TRUE.
      N = 0
*
C  BEGIN EXERCISING ODRPACK
*
      DO 400 ITEST=1,NTEST
*
C  SET CONTROL VALUES TO INVOKE DEFAULT VALUES
*
         IFIXX(1,1) = -1
         LDIFX = MAXN
         IFIXB(1) = -1
         W(1) = -ONE
         NDIGIT = -1
         TAUFAC = -ONE
         SSTOL = -ONE
         PARTOL = -ONE
         MAXIT = -1
         IPRINT = 2112
*
         IF (ITEST.EQ.1) THEN
*
C  TEST SIMPLE ODR PROBLEM WITH ANALYTIC DERIVATIVES USING SODR
*
            LUN = LUNRPT
            DO 10 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1010)
               LUN = LUNSUM
   10       CONTINUE
            SETNO = 5
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00010
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = 1
            SHORT = .TRUE.
         ELSE IF (ITEST.EQ.2) THEN
*
C  TEST SIMPLE OLS PROBLEM WITH FINITE DIFFERENCE DERIVATIVES USING SODR
*
            LUN = LUNRPT
            DO 20 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1020)
               LUN = LUNSUM
   20       CONTINUE
            SETNO = 5
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00001
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = 1
            SHORT = .TRUE.
         ELSE IF (ITEST.EQ.3) THEN
*
C  TEST PARAMETER FIXING CAPABILITIES FOR POORLY SCALED OLS PROBLEM
C  WITH ANALYTIC DERIVATIVES USING SODRC.
*
            LUN = LUNRPT
            DO 30 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1030)
               LUN = LUNSUM
   30       CONTINUE
            SETNO = 3
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00031
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = 1
            SHORT = .FALSE.
            IFIXB(1) = 1
            IFIXB(2) = 1
            IFIXB(3) = 1
            IFIXB(4) = 0
            IFIXB(5) = 1
            IFIXB(6) = 0
            IFIXB(7) = 0
            IFIXB(8) = 0
            IFIXB(9) = 0
         ELSE IF (ITEST.EQ.4) THEN
*
C  TEST WEIGHTING CAPABILITIES FOR ODR PROBLEM WITH
C  ANALYTIC DERIVATIVES USING SODRC.
C  ALSO SHOWS SOLUTION OF POORLY SCALED ODR PROBLEM
C  (DERIVATIVE CHECKING TURNED OFF)
*
            LUN = LUNRPT
            DO 40 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1040)
               LUN = LUNSUM
   40       CONTINUE
            SETNO = 3
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00020
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            DO 45 I=1,N
               WD(I,1) = P01/ABS(X(I,1))
               W(I) = ONE
   45       CONTINUE
            LDWD = N
            W(28) = ZERO
            SHORT = .FALSE.
            IFIXB(1) = 1
            IFIXB(2) = 1
            IFIXB(3) = 1
            IFIXB(4) = 0
            IFIXB(5) = 1
            IFIXB(6) = 1
            IFIXB(7) = 1
            IFIXB(8) = 0
            IFIXB(9) = 0
            IPRINT = 2232
         ELSE IF (ITEST.EQ.5) THEN
*
C  TEST DELTA INITIALIZATION CAPABILITIES AND USER-SUPPLIED SCALING
C  TEST DELTA INITIALIZATION CAPABILITIES
C  AND USE OF ISTOPF TO RESTRICT PARAMETER VALUES
C  FOR ODR PROBLEM WITH ANALYTIC DERIVATIVES USING SODRC.
*
            LUN = LUNRPT
            DO 50 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1050)
               LUN = LUNSUM
   50       CONTINUE
            SETNO = 1
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 01010
            SCLD(1,1) = TWO
            LDSCLD = 1
            SCLB(1) = P2
            SCLB(2) = ONE
            WD(1,1) = -ONE
            LDWD = N
            DO 55 I=20,21
               WORK(I) = BETA(1)/Y(I) + BETA(2) - X(I,1)
   55       CONTINUE
            SHORT = .FALSE.
         ELSE IF (ITEST.EQ.6) THEN
*
C  TEST STIFF STOPPING CONDITIONS FOR UNSCALED ODR PROBLEM
C  WITH ANALYTIC DERIVATIVES USING SODRC
*
            LUN = LUNRPT
            DO 60 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1060)
               LUN = LUNSUM
   60       CONTINUE
            SETNO = 4
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00010
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
            SSTOL = HUNDRD*EPSMAC
            PARTOL = EPSMAC
            MAXIT = 2
         ELSE IF (ITEST.EQ.7) THEN
*
C  TEST RESTART FOR UNSCALED ODR PROBLEM
C  WITH ANALYTIC DERIVATIVES USING SODRC
*
            LUN = LUNRPT
            DO 70 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1070)
               LUN = LUNSUM
   70       CONTINUE
            SETNO = 4
            JOB = 20210
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
            SSTOL = HUNDRD*EPSMAC
            PARTOL = EPSMAC
            MAXIT = -1
         ELSE IF (ITEST.EQ.8) THEN
*
C  TEST USE OF TAUFAC TO RESTRICT FIRST STEP
C  FOR ODR PROBLEM WITH FINITE DIFFERENCE DERIVATIVES USING SODRC.
*
            LUN = LUNRPT
            DO 80 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1080)
               LUN = LUNSUM
   80       CONTINUE
            SETNO = 6
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00200
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
            TAUFAC = P01
         ELSE IF (ITEST.EQ.9) THEN
*
C  TEST DETECTION OF INCORRECT DERIVATIVES
*
            LUN = LUNRPT
            DO 90 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1090)
               LUN = LUNSUM
   90       CONTINUE
            SETNO = 6
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00011
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
         ELSE IF (ITEST.EQ.10) THEN
*
C  TEST DETECTION OF INCORRECT DERIVATIVES
*
            LUN = LUNRPT
            DO 100 I=1,2
               WRITE (LUN,1000) ITEST
               WRITE (LUN,1100)
               LUN = LUNSUM
  100       CONTINUE
            SETNO = 6
            CALL SODRXD(TITLE,N,M,NP,X,LDX,Y,BETA)
            CALL SZERO(LWORK,1,WORK,LWORK)
            JOB = 00010
            SCLD(1,1) = -ONE
            LDSCLD = 1
            SCLB(1) = -ONE
            WD(1,1) = -ONE
            LDWD = N
            SHORT = .FALSE.
         END IF
*
         CALL SIWINF
     +      (M,NP,
     +      MSGB,MSGX,JPVTI,
     +      NNZWI,NPPI,IDFI,
     +      JOBI,IPRINI,LUNERI,LUNRPI,
     +      NROWI,NTOLI,NETAI,
     +      MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +      LIWKMN)
         CALL SWINF
     +      (N,M,NP,
     +      DELTAI,EPSI,
     +      WSSI,WSSDEI,WSSEPI,RVARI,
     +      PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +      FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +      DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +      ALPHAI,VCVI,OMEGAI,YTI,UI,QRAUXI,WRK1I,SEI,RCONDI,
     +      ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +      LWKMN)
         CALL SODRXW
     +      (N,M,NP,LIWMIN,LWMIN)
*
C  COMPUTE OLS SOLUTION USING ODRPAK WITH F.D. DERIVATIVES
*
         WRITE (LUNRPT,2200) TITLE
         WRITE (LUNSUM,2200) TITLE
         IF (SHORT) THEN
            CALL SODR
     +         (SODRXF,SODRXJ,
     +         N,M,NP,
     +         X,LDX,
     +         Y,
     +         BETA,
     +         WD,LDWD,
     +         JOB,
     +         IPRINT,LUNERR,LUNRPT,
     +         WORK,LWMIN,IWORK,LIWMIN,
     +         INFO)
         ELSE
            CALL SODRC
     +         (SODRXF,SODRXJ,
     +         N,M,NP,
     +         X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +         Y,
     +         BETA,IFIXB,SCLB,
     +         WD,LDWD,W,
     +         JOB,NDIGIT,TAUFAC,
     +         SSTOL,PARTOL,MAXIT,
     +         IPRINT,LUNERR,LUNRPT,
     +         WORK,LWMIN,IWORK,LIWMIN,
     +         INFO)
         END IF
*
C  COMPARE RESULTS WITH THOSE OBTAINED ON THE CDC CYBER 205
C  USING DOUBLE PRECISION VERSION OF ODRPACK
*
         BNRM = SNRM2(NP,BETA,1)
         RSSQ = WORK(WSSI)
*
         IF (IDP205(ITEST).EQ.INFO) THEN
*
C  STOPPING CONDITIONS AGREE
*
            IF (INFO.GE.10000) THEN
               FAILS = .FALSE.
               MSG = 1
*
            ELSE
               IF (MOD(INFO,10).EQ.1) THEN
                  FAILS = ABS(RSSQ-DP205(2,ITEST)).GT.
     +                    DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.2) THEN
                  FAILS = ABS(BNRM-DP205(1,ITEST)).GT.
     +                    DP205(1,ITEST)*WORK(PARTLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.3) THEN
                  FAILS = (ABS(RSSQ-DP205(2,ITEST)).GT.
     +                     DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL)
     +                    .AND.
     +                    (ABS(BNRM-DP205(1,ITEST)).GT.
     +                     DP205(1,ITEST)*WORK(PARTLI)*TSTTOL)
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.4) THEN
                  FAILS = .FALSE.
                  MSG = 1
*
               ELSE
                  FAILS = .TRUE.
                  MSG = 4
               END IF
            END IF
*
         ELSE
            IF (INFO.GE.10000) THEN
               FAILS = .TRUE.
               MSG = 3
*
            ELSE
               IF (MOD(INFO,10).EQ.1) THEN
                  FAILS = ABS(RSSQ-DP205(2,ITEST)).GT.
     +                    DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.2) THEN
                  FAILS = ABS(BNRM-DP205(1,ITEST)).GT.
     +                    DP205(1,ITEST)*WORK(PARTLI)*TSTTOL
                  MSG = 2
*
               ELSE IF (MOD(INFO,10).EQ.3) THEN
                  FAILS = (ABS(RSSQ-DP205(2,ITEST)).GT.
     +                     DP205(2,ITEST)*WORK(SSTOLI)*TSTTOL)
     +                    .AND.
     +                    (ABS(BNRM-DP205(1,ITEST)).GT.
     +                     DP205(1,ITEST)*WORK(PARTLI)*TSTTOL)
                  MSG = 2
*
               ELSE
                  FAILS = .TRUE.
                  MSG = 3
               END IF
            END IF
         END IF
*
         FAILED = FAILED .OR. FAILS
*
         LUN = LUNRPT
         DO 300 L=1,2
            WRITE (LUN,3100)
            WRITE (LUN,3210) ' CDC CYBER 205 RESULT = ',
     +         DP205(1,ITEST),DP205(2,ITEST),IDP205(ITEST)
            WRITE (LUN,3210) ' NEW TEST RESULT      = ',
     +         BNRM,RSSQ,INFO
            WRITE (LUN,3210) ' DIFFERENCE           = ',
     +         ABS(DP205(1,ITEST)-BNRM),ABS(DP205(2,ITEST)-RSSQ),
     +         ABS(IDP205(ITEST)-INFO)
*
            IF (MSG.EQ.1) THEN
               WRITE (LUN,3310)
            ELSE IF (MSG.EQ.2) THEN
               IF (FAILS) THEN
                  WRITE (LUN,3320)
               ELSE
                  WRITE (LUN,3330)
               END IF
            ELSE IF (MSG.EQ.3) THEN
               WRITE (LUN,3340)
            ELSE IF (MSG.EQ.4) THEN
               WRITE (LUN,3350)
            END IF
*
            LUN = LUNSUM
  300    CONTINUE
  400 CONTINUE
*
      IF (FAILED) THEN
         WRITE (LUNSUM,4100)
         PASSED = .FALSE.
      ELSE
         WRITE (LUNSUM,4200)
         PASSED = .TRUE.
      END IF
*
C  FORMAT STATEMENTS
*
 1000 FORMAT('1EXAMPLE ', I2/)
 1010 FORMAT(' TEST SIMPLE ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING SODR.')
 1020 FORMAT(' TEST SIMPLE OLS PROBLEM'/
     +       ' WITH FINITE DIFFERENCE DERIVATIVES',
     +       ' USING SODR.')
 1030 FORMAT(' TEST PARAMETER FIXING CAPABILITIES',
     +       ' FOR POORLY SCALED OLS PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING SODRC.')
 1040 FORMAT(' TEST WEIGHTING CAPABILITIES',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING SODRC. '/
     +       ' ALSO SHOWS SOLUTION OF POORLY SCALED',
     +       ' ODR PROBLEM.'/
     +       ' (DERIVATIVE CHECKING TURNED OFF.)')
 1050 FORMAT(' TEST DELTA INITIALIZATION CAPABILITIES'/
     +       ' AND USE OF ISTOPF TO RESTRICT PARAMETER VALUES',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING SODRC.')
 1060 FORMAT(' TEST STIFF STOPPING CONDITIONS',
     +       ' FOR UNSCALED ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING SODRC.')
 1070 FORMAT(' TEST RESTART',
     +       ' FOR UNSCALED ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING SODRC.')
 1080 FORMAT(' TEST USE OF TAUFAC TO RESTRICT FIRST STEP',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH FINITE DIFFERENCE DERIVATIVES',
     +       ' USING SODRC.')
 1090 FORMAT(' TEST DETECTION OF QUESTIONABLE ANALYTIC DERIVATIVES',
     +       ' FOR OLS PROBLEM'/
     +       ' USING SODRC.')
 1100 FORMAT(' TEST DETECTION OF INCORRECT ANALYTIC DERIVATIVES',
     +       ' FOR ODR PROBLEM'/
     +       ' WITH ANALYTIC DERIVATIVES',
     +       ' USING SODRC.')
 2200 FORMAT (' DATA SET REFERENCE: ', A80)
 3100 FORMAT
     +   (//' *** COMPARISON OF NEW RESULTS WITH',
     +      ' DOUBLE PRECISION CDC CYBER 205 RESULT ***'//
     +      '                         NORM OF BETA',
     +      '        SUM OF SQUARED WTD OBS ERRORS  INFO')
 3210 FORMAT
     +   (/A25/2E37.30,I6)
 3310 FORMAT
     +   (///' NEW STOPPING CONDITION AND EXPECTED STOPPING CONDITION',
     +       ' AGREE,'/
     +       ' BUT INDICATE CONVERGENCE WAS NOT ATTAINED.'/
     +       ' NO FURTHER COMPARISONS WILL BE MADE BETWEEN NEW AND',
     +       ' EXPECTED RESULTS.')
 3320 FORMAT
     +   (///' *** WARNING ***'//
     +       ' NEW RESULTS AND EXPECTED RESULTS DO NOT',
     +       ' AGREE TO WITHIN STOPPING TOLERANCE'/
     +       ' OF NEW RESULT.')
 3330 FORMAT
     +   (///' NEW RESULTS AND EXPECTED RESULTS',
     +       ' AGREE TO WITHIN STOPPING TOLERANCE'/
     +       ' OF NEW RESULTS.')
 3340 FORMAT
     +   (///' *** WARNING ***'//
     +       ' NEW STOPPING CONDITION AND EXPECTED STOPPING CONDITION',
     +       ' DO NOT AGREE.'/
     +       ' NO FURTHER COMPARISONS WILL BE MADE BETWEEN NEW AND',
     +       ' EXPECTED RESULTS.')
 3350 FORMAT
     +   (///' *** WARNING ***'//
     +       ' UNEXPECTED STOPPING CONDITION.'/
     +       ' PLEASE CONTACT PACKAGE AUTHORS.')
 4100 FORMAT
     +   (///
     +   '1*** WARNING ***'//
     +   ' RESULTS FROM ONE OR MORE OF THE TESTS DO NOT',
     +   ' AGREE WITH THE EXPECTED RESULTS'/
     +   ' (OBTAINED USING DOUBLE PRECISION VERSION OF ODRPACK',
     +   ' RUN ON CDC CYBER 205).'/
     +   ' INSTALLATION OF ODRPACK SHOULD NOT BE CONSIDERED',
     +   ' SUCCESSFUL'/
     +   ' UNLESS FURTHER EXAMINATION OF THE RESULTS FINDS',
     +   ' THE DISCREPANCY TO BE INSIGNIFICANT.')
 4200 FORMAT
     +   (///
     +   '1RESULTS FROM ALL OF THE TESTS',
     +   ' AGREE WITH THE EXPECTED RESULTS'/
     +   ' (OBTAINED USING DOUBLE PRECISION VERSION OF ODRPACK',
     +   ' RUN ON CDC CYBER 205).'/
     +   ' INSTALLATION OF ODRPACK CAN BE CONSIDERED SUCCESSFUL.')
*
      END
*SODRXD
      SUBROUTINE SODRXD
     +   (TITLE,N,M,NP,X,LDX,Y,BETA)
C***BEGIN PROLOGUE  SODRXD
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET UP DATA FOR ODRPACK EXERCISER
C***END PROLOGUE  SODRXD
*
C  SET PARAMETERS FOR MAXIMUM PROBLEM SIZE HANDLED BY THIS DRIVER, WHERE
C         MAXN IS THE MAXIMUM NUMBER OF OBSERVATIONS ALLOWED,
C         MAXM IS THE MAXIMUM NUMBER OF COLUMNS IN THE
C              INDEPENDENT VARIABLE ALLOWED,
C        MAXNP IS THE MAXIMUM NUMBER OF FUNCTION PARAMETERS
C              ALLOWED, AND
C       MAXSET IS THE NUMBER OF DIFFERENT DATA SETS AVAILABLE.
*
C...PARAMETERS
      INTEGER
     +    MAXN,MAXM,MAXNP,MAXSET
      PARAMETER
     +    (MAXN=50,MAXNP=10,MAXM=3,MAXSET=10)
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDX,M,N,NP
      CHARACTER TITLE*80
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(*),X(LDX,*),Y(*)
*
C...SCALARS IN COMMON
      INTEGER
     +   SETNO
*
C...LOCAL SCALARS
      INTEGER
     +   I,J,K
*
C...LOCAL ARRAYS
      REAL
     +   BDATA(MAXNP,MAXSET),XDATA(MAXN,MAXM,MAXSET),
     +   YDATA(MAXN,MAXSET)
      INTEGER
     +   MDATA(MAXSET),NDATA(MAXSET),NPDATA(MAXSET)
      CHARACTER TDATA(MAXSET)*80
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
*
C...DATA STATEMENTS
      DATA
     +   TDATA(1)
     +   /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1'/
      DATA
     +   NDATA(1),MDATA(1),NPDATA(1)
     +   /40,1,2/
      DATA
     +   (BDATA(K,1),K=1,2)
     +   /1.0E+0,1.0E+0/
      DATA
     +   YDATA(1,1),XDATA(1,1,1)
     +   /-0.119569795672791172E+1,-0.213701920211315155E-1/
      DATA
     +   YDATA(2,1),XDATA(2,1,1)
     +   /-0.128023349509594288E+1,0.494813247025012969E-1/
      DATA
     +   YDATA(3,1),XDATA(3,1,1)
     +   /-0.125270693343174591E+1,0.127889194935560226E+0/
      DATA
     +   YDATA(4,1),XDATA(4,1,1)
     +   /-0.996698267935287383E+0,0.128615394085645676E+0/
      DATA
     +   YDATA(5,1),XDATA(5,1,1)
     +   /-0.104681033065801934E+1,0.232544285655021667E+0/
      DATA
     +   YDATA(6,1),XDATA(6,1,1)
     +   /-0.146724952092847308E+1,0.268151108026504516E+0/
      DATA
     +   YDATA(7,1),XDATA(7,1,1)
     +   /-0.123366891873487528E+1,0.309041029810905456E+0/
      DATA
     +   YDATA(8,1),XDATA(8,1,1)
     +   /-0.165665097907185554E+1,0.405991539210081099E+0/
      DATA
     +   YDATA(9,1),XDATA(9,1,1)
     +   /-0.168476460930907119E+1,0.376611424833536147E+0/
      DATA
     +   YDATA(10,1),XDATA(10,1,1)
     +   /-0.198571971169224491E+1,0.475875890851020811E+0/
      DATA
     +   YDATA(11,1),XDATA(11,1,1)
     +   /-0.195691696638051344E+1,0.499246935397386550E+0/
      DATA
     +   YDATA(12,1),XDATA(12,1,1)
     +   /-0.211871342665769836E+1,0.536615037024021147E+0/
      DATA
     +   YDATA(13,1),XDATA(13,1,1)
     +   /-0.268642932558671020E+1,0.581830765902996060E+0/
      DATA
     +   YDATA(14,1),XDATA(14,1,1)
     +   /-0.281123260058024347E+1,0.684512710422277446E+0/
      DATA
     +   YDATA(15,1),XDATA(15,1,1)
     +   /-0.328704486581785920E+1,0.660219819694757458E+0/
      DATA
     +   YDATA(16,1),XDATA(16,1,1)
     +   /-0.423062993461887032E+1,0.766990323960781092E+0/
      DATA
     +   YDATA(17,1),XDATA(17,1,1)
     +   /-0.512043906552226903E+1,0.808270426690578456E+0/
      DATA
     +   YDATA(18,1),XDATA(18,1,1)
     +   /-0.731032616379005535E+1,0.897410020083189004E+0/
      DATA
     +   YDATA(19,1),XDATA(19,1,1)
     +   /-0.109002759485608993E+2,0.959199774116277687E+0/
      DATA
     +   YDATA(20,1),XDATA(20,1,1)
     +   /-0.251810238510370206E+2,0.914675474762916558E+0/
      DATA
     +   YDATA(21,1),XDATA(21,1,1)
     +   /0.100123028650879944E+3,0.997759691476821892E+0/
      DATA
     +   YDATA(22,1),XDATA(22,1,1)
     +   /0.168225085871915048E+2,0.107136870384216308E+1/
      DATA
     +   YDATA(23,1),XDATA(23,1,1)
     +   /0.894830510866913009E+1,0.108033321037888526E+1/
      DATA
     +   YDATA(24,1),XDATA(24,1,1)
     +   /0.645853815227747004E+1,0.116064198672771453E+1/
      DATA
     +   YDATA(25,1),XDATA(25,1,1)
     +   /0.498218564760117328E+1,0.119080889359116553E+1/
      DATA
     +   YDATA(26,1),XDATA(26,1,1)
     +   /0.382971664718710476E+1,0.129418875187635420E+1/
      DATA
     +   YDATA(27,1),XDATA(27,1,1)
     +   /0.344116492497344184E+1,0.135594148099422453E+1/
      DATA
     +   YDATA(28,1),XDATA(28,1,1)
     +   /0.276840496973858949E+1,0.135302808716893195E+1/
      DATA
     +   YDATA(29,1),XDATA(29,1,1)
     +   /0.259521665196956666E+1,0.137994666010141371E+1/
      DATA
     +   YDATA(30,1),XDATA(30,1,1)
     +   /0.205996022794557661E+1,0.147630019545555113E+1/
      DATA
     +   YDATA(31,1),XDATA(31,1,1)
     +   /0.197939614345337836E+1,0.153450708076357840E+1/
      DATA
     +   YDATA(32,1),XDATA(32,1,1)
     +   /0.156739340562905589E+1,0.152805351451039313E+1/
      DATA
     +   YDATA(33,1),XDATA(33,1,1)
     +   /0.159032057073028366E+1,0.157147316247224806E+1/
      DATA
     +   YDATA(34,1),XDATA(34,1,1)
     +   /0.173102268158937949E+1,0.166649596005678175E+1/
      DATA
     +   YDATA(35,1),XDATA(35,1,1)
     +   /0.155512561664824758E+1,0.166505665838718412E+1/
      DATA
     +   YDATA(36,1),XDATA(36,1,1)
     +   /0.149635994944133260E+1,0.175214128553867338E+1/
      DATA
     +   YDATA(37,1),XDATA(37,1,1)
     +   /0.147487601463073568E+1,0.180567992463707922E+1/
      DATA
     +   YDATA(38,1),XDATA(38,1,1)
     +   /0.117244575233306998E+1,0.184624404296278952E+1/
      DATA
     +   YDATA(39,1),XDATA(39,1,1)
     +   /0.910931336069172580E+0,0.195568727388978002E+1/
      DATA
     +   YDATA(40,1),XDATA(40,1,1)
     +   /0.126172980914513272E+1,0.199326394036412237E+1/
      DATA
     +   TDATA(2)
     +   /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2'/
      DATA
     +   NDATA(2),MDATA(2),NPDATA(2)
     +   /50,2,3/
      DATA
     +   (BDATA(K,2),K=1,3)
     +   /-1.0E+0,1.0E+0,1.0E+0/
      DATA
     +   YDATA(1,2),XDATA(1,1,2),XDATA(1,2,2)
     +   /0.680832777217942900E+0,
     +   0.625474598833994800E-1,0.110179064209783100E+0/
      DATA
     +   YDATA(2,2),XDATA(2,1,2),XDATA(2,2,2)
     +   /0.122183594595302200E+1,
     +   0.202500343620642400E+0,-0.196140862891327600E-1/
      DATA
     +   YDATA(3,2),XDATA(3,1,2),XDATA(3,2,2)
     +   /0.118958678734608200E+1,
     +   0.164943738599876500E+0,0.166514874750996600E+0/
      DATA
     +   YDATA(4,2),XDATA(4,1,2),XDATA(4,2,2)
     +   /0.146982623764094600E+1,
     +   0.304874137610506100E+0,0.612908688041490500E-2/
      DATA
     +   YDATA(5,2),XDATA(5,1,2),XDATA(5,2,2)
     +   /0.167775338189355300E+1,
     +   0.532727445580665100E+0,0.938248787552444600E-1/
      DATA
     +   YDATA(6,2),XDATA(6,1,2),XDATA(6,2,2)
     +   /0.202485721906026200E+1,
     +   0.508823707598910200E+0,0.499605775020505400E-2/
      DATA
     +   YDATA(7,2),XDATA(7,1,2),XDATA(7,2,2)
     +   /0.258912851935938800E+1,
     +   0.704227041878554000E+0,0.819354849092326200E-1/
      DATA
     +   YDATA(8,2),XDATA(8,1,2),XDATA(8,2,2)
     +   /0.366894203254154800E+1,
     +   0.592077736111512000E+0,0.127113960672389100E-1/
      DATA
     +   YDATA(9,2),XDATA(9,1,2),XDATA(9,2,2)
     +   /0.574609583351347300E+1,
     +   0.104940945646421600E+1,0.258095243658316100E-1/
      DATA
     +   YDATA(10,2),XDATA(10,1,2),XDATA(10,2,2)
     +   /0.127676424026489300E+2,0.979382517558619200E+0,
     +   0.124280755181027900E+0/
      DATA
     +   YDATA(11,2),XDATA(11,1,2),XDATA(11,2,2)
     +   /0.123473079693623100E+1,0.637870453165538700E-1,
     +   0.304856401137196400E+0/
      DATA
     +   YDATA(12,2),XDATA(12,1,2),XDATA(12,2,2)
     +   /0.142256120864082800E+1,0.176123312906025700E+0,
     +   0.262387028078896900E+0/
      DATA
     +   YDATA(13,2),XDATA(13,1,2),XDATA(13,2,2)
     +   /0.169889534013024700E+1,0.310965082300263000E+0,
     +   0.226430765474758800E+0/
      DATA
     +   YDATA(14,2),XDATA(14,1,2),XDATA(14,2,2)
     +   /0.173485577901204400E+1,0.311394269116782100E+0,
     +   0.271375840410281800E+0/
      DATA
     +   YDATA(15,2),XDATA(15,1,2),XDATA(15,2,2)
     +   /0.277761263972834600E+1,0.447076126190612500E+0,
     +   0.255000858902618300E+0/
      DATA
     +   YDATA(16,2),XDATA(16,1,2),XDATA(16,2,2)
     +   /0.339163324662617300E+1,0.384786230998211100E+0,
     +   0.154958003178364000E+0/
      DATA
     +   YDATA(17,2),XDATA(17,1,2),XDATA(17,2,2)
     +   /0.589615137312147500E+1,0.649093176450780500E+0,
     +   0.258301685463773200E+0/
      DATA
     +   YDATA(18,2),XDATA(18,1,2),XDATA(18,2,2)
     +   /0.124415625214576800E+2,0.685612005372525500E+0,
     +   0.107391260603228600E+0/
      DATA
     +   YDATA(19,2),XDATA(19,1,2),XDATA(19,2,2)
     +   /-0.498491739153861600E+2,0.968747139425088400E+0,
     +   0.151932526135740700E+0/
      DATA
     +   YDATA(20,2),XDATA(20,1,2),XDATA(20,2,2)
     +   /-0.832795509000618600E+1,0.869789367989532900E+0,
     +   0.625507500586400000E-1/
      DATA
     +   YDATA(21,2),XDATA(21,1,2),XDATA(21,2,2)
     +   /0.184934617774239900E+1,-0.465309930332736600E-2,
     +   0.546795662595375200E+0/
      DATA
     +   YDATA(22,2),XDATA(22,1,2),XDATA(22,2,2)
     +   /0.175192979176839200E+1,0.604753397196646000E-2,
     +   0.230905749473922700E+0/
      DATA
     +   YDATA(23,2),XDATA(23,1,2),XDATA(23,2,2)
     +   /0.253949381238535800E+1,0.239418809621756000E+0,
     +   0.190752069681170700E+0/
      DATA
     +   YDATA(24,2),XDATA(24,1,2),XDATA(24,2,2)
     +   /0.373500774928501700E+1,0.456662468911699800E+0,
     +   0.328870615170984400E+0/
      DATA
     +   YDATA(25,2),XDATA(25,1,2),XDATA(25,2,2)
     +   /0.548408128950331000E+1,0.371115320522079500E+0,
     +   0.439978556640660500E+0/
      DATA
     +   YDATA(26,2),XDATA(26,1,2),XDATA(26,2,2)
     +   /0.125256880521774300E+2,0.586442107042503000E+0,
     +   0.490689043752286700E+0/
      DATA
     +   YDATA(27,2),XDATA(27,1,2),XDATA(27,2,2)
     +   /-0.493587797164916600E+2,0.579796274973298000E+0,
     +   0.521860998203383100E+0/
      DATA
     +   YDATA(28,2),XDATA(28,1,2),XDATA(28,2,2)
     +   /-0.801158974965412700E+1,0.805008094903899900E+0,
     +   0.292283538955391600E+0/
      DATA
     +   YDATA(29,2),XDATA(29,1,2),XDATA(29,2,2)
     +   /-0.437399487061934100E+1,0.637242340835710000E+0,
     +   0.402261740352486000E+0/
      DATA
     +   YDATA(30,2),XDATA(30,1,2),XDATA(30,2,2)
     +   /-0.297800103425979600E+1,0.982132817936118700E+0,
     +   0.392546836419047000E+0/
      DATA
     +   YDATA(31,2),XDATA(31,1,2),XDATA(31,2,2)
     +   /0.271811057454661300E+1,-0.223515657121262700E-1,
     +   0.650479019708978800E+0/
      DATA
     +   YDATA(32,2),XDATA(32,1,2),XDATA(32,2,2)
     +   /0.377035865613392400E+1,0.136081427545033600E+0,
     +   0.753020101897661800E+0/
      DATA
     +   YDATA(33,2),XDATA(33,1,2),XDATA(33,2,2)
     +   /0.560111053917143100E+1,0.145367053019870600E+0,
     +   0.611153532003093100E+0/
      DATA
     +   YDATA(34,2),XDATA(34,1,2),XDATA(34,2,2)
     +   /0.128152376174926800E+2,0.308221919576435500E+0,
     +   0.455217283290423900E+0/
      DATA
     +   YDATA(35,2),XDATA(35,1,2),XDATA(35,2,2)
     +   /-0.498709177732467200E+2,0.432658769133528300E+0,
     +   0.678607663414113000E+0/
      DATA
     +   YDATA(36,2),XDATA(36,1,2),XDATA(36,2,2)
     +   /-0.815797696908314300E+1,0.477785501079980300E+0,
     +   0.536178207572157000E+0/
      DATA
     +   YDATA(37,2),XDATA(37,1,2),XDATA(37,2,2)
     +   /-0.440240491195158600E+1,0.727986827616619000E+0,
     +   0.668497920573493900E+0/
      DATA
     +   YDATA(38,2),XDATA(38,1,2),XDATA(38,2,2)
     +   /-0.276723957061767500E+1,0.745950385588265100E+0,
     +   0.786077589007263700E+0/
      DATA
     +   YDATA(39,2),XDATA(39,1,2),XDATA(39,2,2)
     +   /-0.223203667288734800E+1,0.732537503527113500E+0,
     +   0.582625164046828400E+0/
      DATA
     +   YDATA(40,2),XDATA(40,1,2),XDATA(40,2,2)
     +   /-0.169728270310622000E+1,0.967352361433846300E+0,
     +   0.460779396016832800E+0/
      DATA
     +   YDATA(41,2),XDATA(41,1,2),XDATA(41,2,2)
     +   /0.551015652153227000E+1,0.129761784310891100E-1,
     +   0.700009537931860000E+0/
      DATA
     +   YDATA(42,2),XDATA(42,1,2),XDATA(42,2,2)
     +   /0.128036180496215800E+2,0.170163243950629700E+0,
     +   0.853131830764348700E+0/
      DATA
     +   YDATA(43,2),XDATA(43,1,2),XDATA(43,2,2)
     +   /-0.498257683396339000E+2,0.162768461906274000E+0,
     +   0.865315129048175000E+0/
      DATA
     +   YDATA(44,2),XDATA(44,1,2),XDATA(44,2,2)
     +   /-0.877334550221761900E+1,0.222914807946165800E+0,
     +   0.797511758502094500E+0/
      DATA
     +   YDATA(45,2),XDATA(45,1,2),XDATA(45,2,2)
     +   /-0.453820192156867600E+1,0.402910095604624900E+0,
     +   0.761492958727023100E+0/
      DATA
     +   YDATA(46,2),XDATA(46,1,2),XDATA(46,2,2)
     +   /-0.297499315738677900E+1,0.233770812593443200E+0,
     +   0.896000095844223500E+0/
      DATA
     +   YDATA(47,2),XDATA(47,1,2),XDATA(47,2,2)
     +   /-0.212743255978538900E+1,0.646528693486914700E+0,
     +   0.968574333700755700E+0/
      DATA
     +   YDATA(48,2),XDATA(48,1,2),XDATA(48,2,2)
     +   /-0.209703205365401000E+1,0.802811658568969400E+0,
     +   0.904866450476711600E+0/
      DATA
     +   YDATA(49,2),XDATA(49,1,2),XDATA(49,2,2)
     +   /-0.155287292042086200E+1,0.837137859891222900E+0,
     +   0.835684424990021900E+0/
      DATA
     +   YDATA(50,2),XDATA(50,1,2),XDATA(50,2,2)
     +   /-0.161356673770480700E+1,0.103165980756526600E+1,
     +   0.793902191912346100E+0/
      DATA
     +   TDATA(3)
     +   /' BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3'/
      DATA
     +   NDATA(3),MDATA(3),NPDATA(3)
     +   /44,1,9/
      DATA
     +   (BDATA(K,3),K=1,9)
     +   /0.281887509408440189E-5,
     +   -0.231290549212363845E-2,0.583035555572801965E+1,
     +   0.000000000000000000E+0,0.406910776203121026E+8,
     +   0.138001105225000000E-2,0.596038513209999999E-1,
     +   0.670582099359999998E+1,0.106994410000000000E+10/
      DATA
     +   YDATA(1,3),XDATA(1,1,3)
     +   /0.988227696721327788E+0,0.25E-8/
      DATA
     +   YDATA(2,3),XDATA(2,1,3)
     +   /0.988268083998559958E+0,0.64E-8/
      DATA
     +   YDATA(3,3),XDATA(3,1,3)
     +   /0.988341022958438831E+0,1.0E-8/
      DATA
     +   YDATA(4,3),XDATA(4,1,3)
     +   /0.988380557606306446E+0,0.9E-7/
      DATA
     +   YDATA(5,3),XDATA(5,1,3)
     +   /0.988275062411751338E+0,1.0E-6/
      DATA
     +   YDATA(6,3),XDATA(6,1,3)
     +   /0.988326680176446987E+0,0.4E-5/
      DATA
     +   YDATA(7,3),XDATA(7,1,3)
     +   /0.988306058860433439E+0,0.9E-5/
      DATA
     +   YDATA(8,3),XDATA(8,1,3)
     +   /0.988292880079125555E+0,0.16E-4/
      DATA
     +   YDATA(9,3),XDATA(9,1,3)
     +   /0.988305279259496905E+0,0.36E-4/
      DATA
     +   YDATA(10,3),XDATA(10,1,3)
     +   /0.988278142019574202E+0,0.64E-4/
      DATA
     +   YDATA(11,3),XDATA(11,1,3)
     +   /0.988224953369819946E+0,1.0E-4/
      DATA
     +   YDATA(12,3),XDATA(12,1,3)
     +   /0.988111989169778223E+0,0.144E-3/
      DATA
     +   YDATA(13,3),XDATA(13,1,3)
     +   /0.988045627103840613E+0,0.225E-3/
      DATA
     +   YDATA(14,3),XDATA(14,1,3)
     +   /0.987913715667047655E+0,0.400E-3/
      DATA
     +   YDATA(15,3),XDATA(15,1,3)
     +   /0.987841994238525678E+0,0.625E-3/
      DATA
     +   YDATA(16,3),XDATA(16,1,3)
     +   /0.987638450432434270E+0,0.900E-3/
      DATA
     +   YDATA(17,3),XDATA(17,1,3)
     +   /0.987587364331771395E+0,0.1225E-2/
      DATA
     +   YDATA(18,3),XDATA(18,1,3)
     +   /0.987576264149633684E+0,0.1600E-2/
      DATA
     +   YDATA(19,3),XDATA(19,1,3)
     +   /0.987539209110983643E+0,0.2025E-2/
      DATA
     +   YDATA(20,3),XDATA(20,1,3)
     +   /0.987621143807705698E+0,0.25E-2/
      DATA
     +   YDATA(21,3),XDATA(21,1,3)
     +   /0.988023229785526217E+0,0.36E-2/
      DATA
     +   YDATA(22,3),XDATA(22,1,3)
     +   /0.988558376710994197E+0,0.49E-2/
      DATA
     +   YDATA(23,3),XDATA(23,1,3)
     +   /0.989304775352439885E+0,0.64E-2/
      DATA
     +   YDATA(24,3),XDATA(24,1,3)
     +   /0.990210452265710472E+0,0.81E-2/
      DATA
     +   YDATA(25,3),XDATA(25,1,3)
     +   /0.991095950592263900E+0,1.00E-2/
      DATA
     +   YDATA(26,3),XDATA(26,1,3)
     +   /0.991475677297119272E+0,0.11025E-1/
      DATA
     +   YDATA(27,3),XDATA(27,1,3)
     +   /0.991901306250746771E+0,0.12100E-1/
      DATA
     +   YDATA(28,3),XDATA(28,1,3)
     +   /0.992619222425303263E+0,0.14400E-1/
      DATA
     +   YDATA(29,3),XDATA(29,1,3)
     +   /0.993617037631973475E+0,0.16900E-1/
      DATA
     +   YDATA(30,3),XDATA(30,1,3)
     +   /0.994727321698030676E+0,0.19600E-1/
      DATA
     +   YDATA(31,3),XDATA(31,1,3)
     +   /0.996523114720326189E+0,0.25600E-1/
      DATA
     +   YDATA(32,3),XDATA(32,1,3)
     +   /0.998036909563764020E+0,0.32400E-1/
      DATA
     +   YDATA(33,3),XDATA(33,1,3)
     +   /0.999151968626971372E+0,0.40000E-1/
      DATA
     +   YDATA(34,3),XDATA(34,1,3)
     +   /0.100017083706131769E+1,0.50625E-1/
      DATA
     +   YDATA(35,3),XDATA(35,1,3)
     +   /0.100110046382923523E+1,0.75625E-1/
      DATA
     +   YDATA(36,3),XDATA(36,1,3)
     +   /0.100059103180404652E+1,0.12250E+0/
      DATA
     +   YDATA(37,3),XDATA(37,1,3)
     +   /0.999211829791257561E+0,0.16000E+0/
      DATA
     +   YDATA(38,3),XDATA(38,1,3)
     +   /0.994711451526761862E+0,0.25000E+0/
      DATA
     +   YDATA(39,3),XDATA(39,1,3)
     +   /0.989844132928847109E+0,0.33640E+0/
      DATA
     +   YDATA(40,3),XDATA(40,1,3)
     +   /0.987234104554490439E+0,0.38440E+0/
      DATA
     +   YDATA(41,3),XDATA(41,1,3)
     +   /0.980928240178404887E+0,0.49E+0/
      DATA
     +   YDATA(42,3),XDATA(42,1,3)
     +   /0.970888680366055576E+0,0.64E+0/
      DATA
     +   YDATA(43,3),XDATA(43,1,3)
     +   /0.960043769857327398E+0,0.81E+0/
      DATA
     +   YDATA(44,3),XDATA(44,1,3)
     +   /0.947277159259551068E+0,1.00E+0/
      DATA
     +   TDATA(4)
     +   /' HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188'/
      DATA
     +   NDATA(4),MDATA(4),NPDATA(4)
     +   /13,2,3/
      DATA
     +   (BDATA(K,4),K=1,3)
     +   /3.0E+0,3.0E+0,-0.5E+0/
      DATA
     +   YDATA(1,4),XDATA(1,1,4),XDATA(1,2,4)
     +   /2.93E+0,0.0E+0,0.0E+0/
      DATA
     +   YDATA(2,4),XDATA(2,1,4),XDATA(2,2,4)
     +   /1.95E+0,0.0E+0,1.0E+0/
      DATA
     +   YDATA(3,4),XDATA(3,1,4),XDATA(3,2,4)
     +   /0.81E+0,0.0E+0,2.0E+0/
      DATA
     +   YDATA(4,4),XDATA(4,1,4),XDATA(4,2,4)
     +   /0.58E+0,0.0E+0,3.0E+0/
      DATA
     +   YDATA(5,4),XDATA(5,1,4),XDATA(5,2,4)
     +   /5.90E+0,1.0E+0,0.0E+0/
      DATA
     +   YDATA(6,4),XDATA(6,1,4),XDATA(6,2,4)
     +   /4.74E+0,1.0E+0,1.0E+0/
      DATA
     +   YDATA(7,4),XDATA(7,1,4),XDATA(7,2,4)
     +   /4.18E+0,1.0E+0,2.0E+0/
      DATA
     +   YDATA(8,4),XDATA(8,1,4),XDATA(8,2,4)
     +   /4.05E+0,1.0E+0,2.0E+0/
      DATA
     +   YDATA(9,4),XDATA(9,1,4),XDATA(9,2,4)
     +   /9.03E+0,2.0E+0,0.0E+0/
      DATA
     +   YDATA(10,4),XDATA(10,1,4),XDATA(10,2,4)
     +   /7.85E+0,2.0E+0,1.0E+0/
      DATA
     +   YDATA(11,4),XDATA(11,1,4),XDATA(11,2,4)
     +   /7.22E+0,2.0E+0,2.0E+0/
      DATA
     +   YDATA(12,4),XDATA(12,1,4),XDATA(12,2,4)
     +   /8.50E+0,2.5E+0,2.0E+0/
      DATA
     +   YDATA(13,4),XDATA(13,1,4),XDATA(13,2,4)
     +   /9.81E+0,2.9E+0,1.8E+0/
      DATA
     +   TDATA(5)
     +   /' DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522'/
      DATA
     +   NDATA(5),MDATA(5),NPDATA(5)
     +   /8,2,2/
      DATA
     +   (BDATA(K,5),K=1,2)
     +   /0.01155E+0,5000.0E+0/
      DATA
     +   YDATA(1,5),XDATA(1,1,5),XDATA(1,2,5)
     +   /0.912E+0,109.0E+0,600.0E+0/
      DATA
     +   YDATA(2,5),XDATA(2,1,5),XDATA(2,2,5)
     +   /0.382E+0,65.0E+0,640.0E+0/
      DATA
     +   YDATA(3,5),XDATA(3,1,5),XDATA(3,2,5)
     +   /0.397E+0,1180.0E+0,600.0E+0/
      DATA
     +   YDATA(4,5),XDATA(4,1,5),XDATA(4,2,5)
     +   /0.376E+0,66.0E+0,640.0E+0/
      DATA
     +   YDATA(5,5),XDATA(5,1,5),XDATA(5,2,5)
     +   /0.342E+0,1270.0E+0,600.0E+0/
      DATA
     +   YDATA(6,5),XDATA(6,1,5),XDATA(6,2,5)
     +   /0.358E+0,69.0E+0,640.0E+0/
      DATA
     +   YDATA(7,5),XDATA(7,1,5),XDATA(7,2,5)
     +   /0.348E+0,1230.0E+0,600.0E+0/
      DATA
     +   YDATA(8,5),XDATA(8,1,5),XDATA(8,2,5)
     +   /0.376E+0,68.0E+0,640.0E+0/
      DATA
     +   TDATA(6)
     +   /' POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGES 153-154'/
      DATA
     +   NDATA(6),MDATA(6),NPDATA(6)
     +   /14,1,3/
      DATA
     +   (BDATA(K,6),K=1,3)
     +   /25.0E+0,30.0E+0,6.0E+0/
      DATA
     +   YDATA(1,6),XDATA(1,1,6)
     +   /26.38E+0,1.0E+0/
      DATA
     +   YDATA(2,6),XDATA(2,1,6)
     +   /25.79E+0,2.0E+0/
      DATA
     +   YDATA(3,6),XDATA(3,1,6)
     +   /25.29E+0,3.0E+0/
      DATA
     +   YDATA(4,6),XDATA(4,1,6)
     +   /24.86E+0,4.0E+0/
      DATA
     +   YDATA(5,6),XDATA(5,1,6)
     +   /24.46E+0,5.0E+0/
      DATA
     +   YDATA(6,6),XDATA(6,1,6)
     +   /24.10E+0,6.0E+0/
      DATA
     +   YDATA(7,6),XDATA(7,1,6)
     +   /23.78E+0,7.0E+0/
      DATA
     +   YDATA(8,6),XDATA(8,1,6)
     +   /23.50E+0,8.0E+0/
      DATA
     +   YDATA(9,6),XDATA(9,1,6)
     +   /23.24E+0,9.0E+0/
      DATA
     +   YDATA(10,6),XDATA(10,1,6)
     +   /23.00E+0,10.0E+0/
      DATA
     +   YDATA(11,6),XDATA(11,1,6)
     +   /22.78E+0,11.0E+0/
      DATA
     +   YDATA(12,6),XDATA(12,1,6)
     +   /22.58E+0,12.0E+0/
      DATA
     +   YDATA(13,6),XDATA(13,1,6)
     +   /22.39E+0,13.0E+0/
      DATA
     +   YDATA(14,6),XDATA(14,1,6)
     +   /22.22E+0,14.0E+0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BDATA(MAXNP,MAXSET)
C        THE FUNCTION PARAMETER DATA SETS.
C     REAL BETA(*)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MDATA(MAXSET)
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE IN
C        EACH DATA SET.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDATA(MAXSET)
C        THE NUMBER OF OBSERVATIONS PER DATA SET.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPDATA(MAXSET)
C        THE NUMBER OF FUNCTION PARAMETERS IN EACH DATA SET.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     CHARACTER*80 TDATA(MAXSET)
C        THE REFERENCE FOR THE DATA SET BEING ANALYZED.
C     CHARACTER*80 TITLE
C        THE REFERENCE FOR THE DATA SET BEING ANALYZED.
C     REAL X(LDX,*)
C        THE ARRAY OF INDEPENDENT VARIABLES.
C     REAL XDATA(MAXN,MAXM,MAXSET)
C        THE ARRAY OF INDEPENDENT VARIABLES FOR EACH DATA SET.
C     REAL Y(*)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL YDATA(MAXN,MAXSET)
C        THE DEPENDENT VARIABLES FOR EACH DATA SET.
*
*
C***FIRST EXECUTABLE STATEMENT  SODRXD
*
*
      TITLE = TDATA(SETNO)
*
      N = NDATA(SETNO)
      M = MDATA(SETNO)
      NP = NPDATA(SETNO)
*
      DO 10 I=1,N
         Y(I) = YDATA(I,SETNO)
   10 CONTINUE
*
      DO 30 J=1,M
         DO 20 I=1,N
            X(I,J) = XDATA(I,J,SETNO)
   20    CONTINUE
   30 CONTINUE
*
      DO 40 K=1,NP
         BETA(K) = BDATA(K,SETNO)
   40 CONTINUE
*
      RETURN
*
      END
*SODRXF
      SUBROUTINE SODRXF
     +   (N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOPF)
C***BEGIN PROLOGUE  SODRXF
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER
C             CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE FUNCTION VALUES FOR ODRPACK EXERCISER
C***END PROLOGUE  SODRXF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPF,LDXPD,M,N,NP
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),F(N),XPLUSD(LDXPD,M)
*
C...SCALARS IN COMMON
      INTEGER
     +   SETNO
*
C...LOCAL SCALARS
      REAL
     +   ONE,ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0E0,1.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHETHER THE
C        THE VALUES OF BETA AND XPLUSD ARE ACCEPTABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ONE
C        THE VALUE 1.0E0.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODRXF
*
*
      IF (SETNO.EQ.1) THEN
*
C  SETNO. 1:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1
*
         IF (BETA(1).LE.1.01E0) THEN
            DO 100 I=1,N
               F(I) = BETA(1)/(XPLUSD(I,1)-BETA(2))
  100       CONTINUE
            ISTOPF = 0
         ELSE
            ISTOPF = 1
         END IF
*
      ELSE IF (SETNO.EQ.2) THEN
*
C  SETNO. 2:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2
*
         DO 200 I=1,N
            F(I) = BETA(1)/(BETA(2)*XPLUSD(I,1)+BETA(3)*XPLUSD(I,2)-ONE)
  200    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.3) THEN
*
C  SETNO. 3:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3
*
         DO 310 I=1,N
            F(I) = ZERO
            DO 300 J=1,4
               F(I) = F(I) + BETA(J)/(XPLUSD(I,1)+BETA(J+5))
  300       CONTINUE
            F(I) = F(I) + BETA(5)
  310    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.4) THEN
*
C  SETNO. 4:  HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188
*
         DO 400 I = 1, N
            F(I) = BETA(1)*XPLUSD(I,1) +
     +             BETA(2)*EXP(BETA(3)*XPLUSD(I,2))
  400    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.5) THEN
*
C  SETNO. 5:  DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522
*
         DO 500 I=1,N
            F(I) = EXP(-BETA(1)*XPLUSD(I,1)*
     +             EXP(-BETA(2)*(ONE/XPLUSD(I,2) - ONE/620.0E0)))
  500    CONTINUE
         ISTOPF = 0
*
      ELSE IF (SETNO.EQ.6) THEN
*
C  SETNO. 6:  POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGE 153-154
*
         DO 600 I=1,N
            F(I) = BETA(1)*
     +             (ONE+BETA(3)*XPLUSD(I,1)/BETA(2))**(-ONE/BETA(3))
  600    CONTINUE
         ISTOPF = 0
      END IF
*
      RETURN
*
      END
*SODRXJ
      SUBROUTINE SODRXJ
     +   (N,NP,M,BETA,XPLUSD,LDXPD,
     +   FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOPJ)
C***BEGIN PROLOGUE  SODRXJ
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE JACOBIAN MATRICIES FOR ODRPACK EXERCISER
C***END PROLOGUE  SODRXJ
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOPJ,LDFJB,LDFJX,LDXPD,M,N,NP
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),FJACB(LDFJB,NP),FJACX(LDFJX,M),
     +   XPLUSD(LDXPD,M)
*
C...SCALARS IN COMMON
      INTEGER
     +   SETNO
*
C...LOCAL SCALARS
      REAL
     +   FAC1,FAC2,FAC3,FAC4,ONE,ZERO
      INTEGER
     +   I,K
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   EXP
*
C...COMMON BLOCKS
      COMMON /SETID/SETNO
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0E0,1.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL FAC1,FAC2,FAC3,FAC4
C        VARIOUS FACTORS AND TERMS USED IN COMPUTING THE JACOBIANS.
C     REAL FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     REAL FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO XPLUSD.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, USED TO DESIGNATE WHETHER THE
C        THE VALUES OF BETA AND XPLUSD ARE ACCEPTABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ONE
C        THE VALUE 1.0E0.
C     INTEGER SETNO
C        THE NUMBER OF THE DATA SET BEING ANALYZED.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODRXJ
*
*
      IF (SETNO.EQ.1) THEN
*
C  SETNO. 1:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1
*
         DO 110 I=1,N
            FJACB(I,1) = ONE/(XPLUSD(I,1)-BETA(2))
            FJACB(I,2) = BETA(1)*(XPLUSD(I,1)-BETA(2))**(-2)
  110    CONTINUE
*
         IF (ISODR) THEN
            DO 120 I=1,N
               FJACX(I,1) = -BETA(1)*(XPLUSD(I,1)-BETA(2))**(-2)
  120       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.2) THEN
*
C  SETNO. 2:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 2
*
         DO 200 I=1,N
            FJACB(I,1) = ONE/
     +                   (BETA(2)*XPLUSD(I,1)+BETA(3)*XPLUSD(I,2)-ONE)
            FJACB(I,2) = -BETA(1)*
     +                   ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                     XPLUSD(I,2)-ONE)**(-2))*
     +                   XPLUSD(I,1)
            FJACB(I,3) = -BETA(1)*
     +                   ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                     XPLUSD(I,2)-ONE)**(-2))*
     +                   XPLUSD(I,2)
  200    CONTINUE
*
         IF (ISODR) THEN
            DO 220 I=1,N
               FJACX(I,1) = -BETA(1)*
     +                      ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                        XPLUSD(I,2)-ONE)**(-2))*
     +                      BETA(2)
               FJACX(I,2) = -BETA(1)*
     +                      ((BETA(2)*XPLUSD(I,1)+BETA(3)*
     +                        XPLUSD(I,2)-ONE)**(-2))*
     +                      BETA(3)
  220       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.3) THEN
*
C  SETNO. 3:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3
*
         DO 310 I=1,N
            FJACB(I,5) = ONE
            DO 300 K=1,4
               FJACB(I,K) = ONE/(XPLUSD(I,1)+BETA(K+5))
               FJACB(I,K+5) = -BETA(K)*(XPLUSD(I,1)+BETA(K+5))**(-2)
  300       CONTINUE
  310    CONTINUE
*
         IF (ISODR) THEN
            DO 330 I=1,N
               FJACX(I,1) = ZERO
               DO 320 K=4,1,-1
                  FJACX(I,1) = FJACX(I,1) -
     +                         BETA(K)*(XPLUSD(I,1)+BETA(K+5))**(-2)
  320          CONTINUE
  330       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.4) THEN
*
C  SETNO. 4:  HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188
*
         DO 410 I=1,N
            FJACB(I,1) = XPLUSD(I,1)
            FJACB(I,2) = EXP(BETA(3)*XPLUSD(I,2))
            FJACB(I,3) = BETA(2)*EXP(BETA(3)*XPLUSD(I,2))*XPLUSD(I,2)
  410    CONTINUE
*
         IF (ISODR) THEN
            DO 420 I=1,N
               FJACX(I,1) = BETA(1)
               FJACX(I,2) = BETA(2)*EXP(BETA(3)*XPLUSD(I,2))*BETA(3)
  420       CONTINUE
         END IF
*
      ELSE IF (SETNO.EQ.5) THEN
*
C  SETNO. 5:  DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522
*
         DO 510 I=1,N
            FAC1 = ONE/XPLUSD(I,2) - ONE/620.0E0
            FAC2 = EXP(-BETA(2)*FAC1)
            FAC3 = BETA(1)*XPLUSD(I,1)
            FAC4 = EXP(-FAC3*FAC2)
*
            FJACB(I,1) = -FAC4*XPLUSD(I,1)*FAC2
            FJACB(I,2) = FAC4*FAC3*FAC2*FAC1
*
            IF (ISODR) THEN
               FJACX(I,1) = -FAC4*BETA(1)*FAC2
               FJACX(I,2) = -FAC4*FAC3*FAC2*BETA(2)/XPLUSD(I,2)**2
            END IF
  510    CONTINUE
*
      ELSE IF (SETNO.EQ.6) THEN
*
C  SETNO. 6:  POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGE 153-154
*
C             N.B.  THIS DERIVATIVE IS INTENTIONALLY CODED INCORRECTLY
*
         DO 610 I=1,N
            FJACB(I,1) = ZERO
            FJACB(I,2) = ZERO
            FJACB(I,3) = ZERO
*
            IF (ISODR) THEN
               FJACX(I,1) = XPLUSD(I,1)
            END IF
  610    CONTINUE
      END IF
*
      ISTOPJ = 0
*
      RETURN
*
      END
*SODRXW
      SUBROUTINE SODRXW
     +   (MAXN,MAXM,MAXNP,LIWMIN,LWMIN)
C***BEGIN PROLOGUE  SODRXW
C***DATE WRITTEN   890205   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE MINIMUM LENGTHS FOR WORK VECTORS
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  NONE
C***END PROLOGUE  SODRXW
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LIWMIN,LWMIN,MAXN,MAXM,MAXNP
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER LIWMIN
C        THE MINIMUM LENGTH OF VECTOR IWORK FOR A GIVEN PROBLEM.
C     INTEGER LWMIN
C        THE MINIMUM LENGTH OF VECTOR WORK FOR A GIVEN PROBLEM.
C     INTEGER MAXM
C        THE NUMBER OF COLUMNS IN THE INDEPENDENT VARIABLE.
C     INTEGER MAXN
C        THE NUMBER OF OBSERVATIONS.
C     INTEGER MAXNP
C        THE NUMBER OF FUNCTION PARAMETERS.
*
*
C***FIRST EXECUTABLE STATEMENT  SODRXW
*
*
      LIWMIN = 19 + 2*MAXNP + MAXM
      LWMIN = 17 + 7*MAXN + 10*MAXN*MAXM + 2*MAXN*MAXNP + 8*MAXNP
*
      RETURN
      END
    8    2    2
  109.0   65.0 1180.0   66.0
 1270.0   69.0 1230.0   68.0
  600.0  640.0  600.0  640.0
  600.0  640.0  600.0  640.0
  0.912  0.382  0.397  0.376
  0.342  0.358  0.348  0.376
0.01155 5000.0
1EXAMPLE  1
 
 TEST SIMPLE ODR PROBLEM
 WITH ANALYTIC DERIVATIVES USING DODR.
 DATA SET REFERENCE:  DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF ODR
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                                8
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS           8
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     2
 NUMBER OF FUNCTION PARAMETERS                         2
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 2
 
 
 
 INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:
 ----------------------------------------------
 
                               COLUMN   1                COLUMN   2
                           OBS 1        OBS N        OBS 1        OBS N
               X -   0.10900D+03  0.68000D+02  0.60000D+03  0.64000D+03
           FIXED -            NO           NO           NO           NO
   INITIAL DELTA -   0.00000D+00  0.00000D+00  0.00000D+00  0.00000D+00
     DELTA SCALE -   0.91743D-02  0.14706D-01  0.15625D-02  0.15625D-02
   DELTA WEIGHTS -   0.10000D+01  0.10000D+01  0.10000D+01  0.10000D+01
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -   0.91200D+00  0.37600D+00
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2
 INITIAL BETA -   0.11550000D-01  0.50000000D+04
        FIXED -               NO              NO
   BETA SCALE -   0.86580087D+02  0.20000000D-03
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  00010        15  0.10D+01  0.15D-07  0.37D-10     50
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE INITIALIZED TO ZERO.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE SUPPLIED BY USER.
      USER-SUPPLIED DERIVATIVES WERE CHECKED.
      THE DERIVATIVES APPEAR TO BE CORRECT.
  E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.67662011D+00
 SUM OF SQUARED WEIGHTED DELTAS                  0.00000000D+00
 SUM OF SQUARED WEIGHTED EPSILONS                0.67662011D+00
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF ODR
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    1      12  0.19694D+00   0.7089D+00   0.4162D+00  0.151D+01   YES
    2      13  0.18655D-02   0.9905D+00   0.9957D+00  0.671D+00   YES
    3      14  0.75326D-03   0.5962D+00   0.5963D+00  0.463D-01   YES
    4      15  0.75326D-03   0.7567D-06   0.7571D-06  0.226D-04   YES
    5      16  0.75326D-03   0.3524D-12   0.3321D-12  0.181D-07   YES
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF ODR
 ======================================
 
 
 
 STOPPING CONDITION (INFO =      1):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 
                                       CONDITION
       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
               5         17          7 0.1888D-06           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.75326396D-03
 SUM OF SQUARED WEIGHTED DELTAS                  0.58236143D-06
 SUM OF SQUARED WEIGHTED EPSILONS                0.75268160D-03
 
 ESTIMATED RESIDUAL VARIANCE                     0.12554399D-03
 (    6 DEGREES OF FREEDOM)
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
             J          BETA(J)     STD. DEV. BETA(J)
             1   0.36579730D-02        0.42218455D-04
             2   0.27627332D+05        0.22245099D+03
 
 
 
 ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
 ---------------------------------------------------
 
     I      EPSILON(I)      DELTA(I,1)      DELTA(I,2)
     1  0.16751965D-02  0.12677198D-05  0.10604403D-04
     2  0.20420781D-02  0.11546520D-04  0.50622485D-04
     3 -0.20674196D-01 -0.64437475D-05 -0.58352278D-03
     4  0.24289506D-02  0.13533286D-04  0.60245720D-04
     5  0.72722747D-02  0.21038103D-05  0.20504371D-03
     6  0.40766834D-02  0.21732463D-04  0.10114328D-03
     7  0.13033178D-01  0.38974007D-05  0.36788839D-03
     8 -0.85448233D-02 -0.46227424D-04 -0.21202526D-03
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.276273319578025693772360682487D+05 0.753263956902291888922951201835D-03     1
 
  NEW TEST RESULT      =
 0.276273319575923051161225885153D+05 0.753263956902281480582095340992D-03     1
 
  DIFFERENCE           =
 0.210264261113479733467102050781D-06 0.104083408558608425664715468884D-16     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE  2
 
 TEST SIMPLE OLS PROBLEM
 WITH FINITE DIFFERENCE DERIVATIVES USING DODR.
 DATA SET REFERENCE:  DRAPER AND SMITH, 1981, EXERCISE I, PAGE 521-522
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF OLS
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                                8
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS           8
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     2
 NUMBER OF FUNCTION PARAMETERS                         2
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 2
 
 
 
 INDEPENDENT VARIABLE SUMMARY:
 -----------------------------
 
                 COLUMN   1                COLUMN   2
             OBS 1        OBS N        OBS 1        OBS N
 X -   0.10900D+03  0.68000D+02  0.60000D+03  0.64000D+03
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -   0.91200D+00  0.37600D+00
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2
 INITIAL BETA -   0.11550000D-01  0.50000000D+04
        FIXED -               NO              NO
   BETA SCALE -   0.86580087D+02  0.20000000D-03
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  00001        15  0.10D+01  0.15D-07  0.37D-10     50
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE FIXED AT ZERO.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE COMPUTED BY FINITE DIFFERENCES.
  E.  FIT IS BY METHOD OF ORDINARY LEAST SQUARES.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.67662011D+00
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF OLS
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    1      10  0.19694D+00   0.7089D+00   0.4162D+00  0.151D+01   YES
    2      14  0.18660D-02   0.9905D+00   0.9957D+00  0.671D+00   YES
    3      18  0.75385D-03   0.5960D+00   0.5961D+00  0.463D-01   YES
    4      22  0.75385D-03   0.3659D-06   0.3660D-06  0.224D-04   YES
    5      26  0.75385D-03   0.4069D-13   0.3890D-13  0.480D-08   YES
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF OLS
 ======================================
 
 
 
 STOPPING CONDITION (INFO =      1):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 
                             CONDITION
       NUMBER OF  NUMBER OF     NUMBER        RANK
      ITERATIONS   FN EVALS  (INVERSE)  DEFICIENCY
               5         30 0.1888D-06           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.75384677D-03
 
 ESTIMATED RESIDUAL VARIANCE                     0.12564113D-03
 (    6 DEGREES OF FREEDOM)
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
             J          BETA(J)     STD. DEV. BETA(J)
             1   0.36579727D-02        0.42219582D-04
             2   0.27627326D+05        0.22245646D+03
 
 
 
 ESTIMATED EPSILON(I), I = 1, ..., N:
 ------------------------------------
 
         INDEX            VALUE -------------->
     1 TO    4   0.16752466D-02  0.20435347D-02 -0.20690748D-01  0.24306567D-02
     5 TO    8   0.72779765D-02  0.40794451D-02  0.13043484D-01 -0.85501979D-02
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.276273263014367257710546255112D+05 0.753846772268713135982387552048D-03     1
 
  NEW TEST RESULT      =
 0.276273263015568700211588293314D+05 0.753846772268713786503691043350D-03     1
 
  DIFFERENCE           =
 0.120144250104203820228576660156D-06 0.650521303491302660404471680522D-18     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE  3
 
 TEST PARAMETER FIXING CAPABILITIES FOR POORLY SCALED OLS PROBLEM
 WITH ANALYTIC DERIVATIVES USING DODRC.
 DATA SET REFERENCE:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF OLS
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                               44
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS          44
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     1
 NUMBER OF FUNCTION PARAMETERS                         9
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 4
 
 
 
 INDEPENDENT VARIABLE SUMMARY:
 -----------------------------
 
                 COLUMN   1
             OBS 1        OBS N
 X -   0.25000D-08  0.10000D+01
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -   0.98823D+00  0.94728D+00
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2               3               4
 INITIAL BETA -   0.28188751D-05 -0.23129055D-02  0.58303556D+01  0.00000000D+00
        FIXED -               NO              NO              NO             YES
   BETA SCALE -   0.35475144D+06  0.43235662D+03  0.17151613D+00  0.35475144D+07
 
        INDEX -                5               6               7               8
 INITIAL BETA -   0.40691078D+08  0.13800111D-02  0.59603851D-01  0.67058210D+01
        FIXED -               NO             YES             YES             YES
   BETA SCALE -   0.24575412D-07  0.72463188D+03  0.16777439D+02  0.14912417D+00
 
        INDEX -                9
 INITIAL BETA -   0.10699441D+10
        FIXED -              YES
   BETA SCALE -   0.93462827D-09
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  00031        15  0.10D+01  0.15D-07  0.37D-10     50
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE FIXED AT ZERO.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE SUPPLIED BY USER.
      USER-SUPPLIED DERIVATIVES WERE NOT CHECKED.
  E.  FIT IS BY METHOD OF ORDINARY LEAST SQUARES.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.72853607D+17
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF OLS
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    1       7  0.12128D-04   0.1000D+01   0.1000D+01  0.149D+01   YES
    2       8  0.12128D-04   0.1367D-09   0.1367D-09  0.916D-05   YES
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF OLS
 ======================================
 
 
 
 STOPPING CONDITION (INFO =      1):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 
                                       CONDITION
       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
               2          9          3 0.4567D-05           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.12128086D-04
 
 ESTIMATED RESIDUAL VARIANCE                     0.30320215D-06
 (   40 DEGREES OF FREEDOM)
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
             J          BETA(J)     STD. DEV. BETA(J)
             1   0.23864554D-05        0.44960316D-06
             2  -0.22045007D-02        0.40156250D-04
             3   0.38227320D+01        0.38316052D-01
             4   0.00000000D+00                 FIXED
             5   0.45336400D+00        0.52741382D-02
             6   0.13800111D-02                 FIXED
             7   0.59603851D-01                 FIXED
             8   0.67058210D+01                 FIXED
             9   0.10699441D+10                 FIXED
 
 
 
 ESTIMATED EPSILON(I), I = 1, ..., N:
 ------------------------------------
 
         INDEX            VALUE -------------->
     1 TO    4  -0.58532411D-04 -0.98922487D-04 -0.17186403D-03 -0.21145608D-03
     5 TO    8  -0.10661300D-03 -0.16037011D-03 -0.14327882D-03 -0.13496826D-03
     9 TO   12  -0.16081292D-03 -0.15138965D-03 -0.11918308D-03 -0.29320925D-04
    13 TO   16   0.10823924D-05  0.79400445D-04  0.11879506D-03  0.32176927D-03
    17 TO   20   0.40932268D-03  0.49532791D-03  0.64470919D-03  0.71021102D-03
    21 TO   24   0.69663179D-03  0.65486308D-03  0.48458577D-03  0.21833926D-03
    25 TO   28   0.18554334D-04 -0.57216848D-05 -0.69819569D-04 -0.52768863D-04
    29 TO   32  -0.30935563D-03 -0.68242284D-03 -0.10501519D-02 -0.12425623D-02
    33 TO   36  -0.11814777D-02 -0.96989876D-03 -0.30291858D-03  0.52133870D-03
    37 TO   40   0.90553687D-03  0.11147333D-02  0.79051510D-03  0.32658143D-03
    41 TO   44  -0.32711425D-03 -0.27655675D-03 -0.58721962D-03  0.92402660D-04
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.106994410000000000000000000000D+10 0.121280859325605632056607752212D-04     1
 
  NEW TEST RESULT      =
 0.106994410000000000000000000000D+10 0.121280859325602464153385021128D-04     1
 
  DIFFERENCE           =
 0.000000000000000000000000000000D+00 0.316790322273108326811552615254D-18     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE  4
 
 TEST WEIGHTING CAPABILITIES FOR ODR PROBLEM
 WITH ANALYTIC DERIVATIVES USING DODRC.
 ALSO SHOWS SOLUTION OF POORLY SCALED ODR PROBLEM.
 (DERIVATIVE CHECKING TURNED OFF.)
 DATA SET REFERENCE:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 3
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF ODR
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                               44
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS          43
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     1
 NUMBER OF FUNCTION PARAMETERS                         9
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 6
 
 
 
 INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:
 ----------------------------------------------
 
                               COLUMN   1
                           OBS 1        OBS N
               X -   0.25000D-08  0.10000D+01
           FIXED -            NO           NO
   INITIAL DELTA -   0.00000D+00  0.00000D+00
     DELTA SCALE -   0.40000D+09  0.10000D+01
   DELTA WEIGHTS -   0.40000D+07  0.10000D-01
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -   0.98823D+00  0.94728D+00
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2               3               4
 INITIAL BETA -   0.23864554D-05 -0.22045007D-02  0.38227320D+01  0.00000000D+00
        FIXED -               NO              NO              NO             YES
   BETA SCALE -   0.41903150D+06  0.45361746D+03  0.26159302D+00  0.41903150D+07
 
        INDEX -                5               6               7               8
 INITIAL BETA -   0.45336400D+00  0.13800111D-02  0.59603851D-01  0.67058210D+01
        FIXED -               NO              NO              NO             YES
   BETA SCALE -   0.22057331D+01  0.72463188D+03  0.16777439D+02  0.14912417D+00
 
        INDEX -                9
 INITIAL BETA -   0.10699441D+10
        FIXED -              YES
   BETA SCALE -   0.93462827D-09
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  00020        15  0.10D+01  0.15D-07  0.37D-10     50
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE INITIALIZED TO ZERO.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE SUPPLIED BY USER.
      USER-SUPPLIED DERIVATIVES WERE NOT CHECKED.
  E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.12125301D-04
 SUM OF SQUARED WEIGHTED DELTAS                  0.00000000D+00
 SUM OF SQUARED WEIGHTED EPSILONS                0.12125301D-04
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF ODR
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N      BETA
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP     INDEX
 ----  ------  -----------  -----------  -----------  ---------  ----     -----
 
    1       9  0.56155D-05   0.5369D+00   0.6023D+00  0.125D+00    NO   1 TO  3
                                                                        4 TO  6
                                                                        7 TO  9
    4      15  0.12073D-05   0.3881D+00   0.4362D+00  0.172D+00    NO   1 TO  3
                                                                        4 TO  6
                                                                        7 TO  9
    7      21  0.78718D-06   0.9951D-01   0.1135D+00  0.110D+00    NO   1 TO  3
                                                                        4 TO  6
                                                                        7 TO  9
   10      26  0.62879D-06   0.8138D-01   0.1132D+00  0.129D+00    NO   1 TO  3
                                                                        4 TO  6
                                                                        7 TO  9
   13      29  0.55851D-06   0.2283D-01   0.3527D-01  0.944D-01    NO   1 TO  3
                                                                        4 TO  6
                                                                        7 TO  9
   16      32  0.54521D-06   0.4932D-02   0.4932D-02  0.470D-02   YES   1 TO  3
                                                                        4 TO  6
                                                                        7 TO  9
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF ODR
 ======================================
 
 
 
 STOPPING CONDITION (INFO =      1):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 
                                       CONDITION
       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
              17         34         18 0.2257D-05           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.54520846D-06
 SUM OF SQUARED WEIGHTED DELTAS                  0.34235911D-06
 SUM OF SQUARED WEIGHTED EPSILONS                0.20284935D-06
 
 ESTIMATED RESIDUAL VARIANCE                     0.14735364D-07
 (   37 DEGREES OF FREEDOM)
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
             J          BETA(J)     STD. DEV. BETA(J)
             1   0.19589651D-04        0.52651889D-05
             2  -0.10685215D-02        0.40956379D-04
             3   0.34273242D+01        0.33460070D-01
             4   0.00000000D+00                 FIXED
             5   0.50568278D+00        0.46736561D-02
             6   0.28878968D-02        0.42486107D-03
             7   0.30315459D-01        0.15303239D-02
             8   0.67058210D+01                 FIXED
             9   0.10699441D+10                 FIXED
 
 
 
 ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
 ---------------------------------------------------
 
     I      EPSILON(I)      DELTA(I,1)
     1  0.88570461D-04  0.69884348D-17
     2  0.48178261D-04  0.24912653D-16
     3 -0.24765244D-04 -0.31264364D-16
     4 -0.64400881D-04 -0.65847783D-14
     5  0.39946257D-04  0.50368051D-12
     6 -0.15447229D-04 -0.31049125D-11
     7 -0.10879481D-05 -0.11002802D-11
     8  0.33883967D-05  0.10737544D-10
     9 -0.33464788D-04 -0.52379092D-09
    10 -0.39563353D-04 -0.18904777D-08
    11 -0.27444853D-04 -0.30614258D-08
    12  0.37753909D-04  0.82637213D-08
    13  0.22856054D-04  0.11017897D-07
    14  0.58219008D-05  0.70398683D-08
    15 -0.68155308D-04 -0.14578533D-06
    16  0.13731197D-04  0.38359467D-07
    17 -0.15868824D-04 -0.38139162D-07
    18 -0.33272425D-04  0.18730032D-09
    19  0.33752323D-04 -0.18516739D-06
    20  0.42226421D-04 -0.63645905D-06
    21 -0.37557687D-05  0.18858089D-06
    22  0.20062115D-04 -0.22275916D-05
    23 -0.55062716D-05  0.11040139D-05
    24 -0.68801374D-04  0.21919657D-04
    25 -0.50497929D-04  0.23388120D-04
    26  0.21076167D-04 -0.11482851D-04
    27  0.57401137D-04 -0.36253055D-04
    28  0.30238977D-03  0.00000000D+00
    29  0.17416601D-03 -0.17716157D-03
    30  0.19806465D-04 -0.23943191D-04
    31 -0.79041005D-04  0.12467075D-03
    32 -0.14768340D-03  0.27645057D-03
    33 -0.11227727D-03  0.23147225D-03
    34 -0.47955311D-04  0.99315748D-04
    35  0.14051142D-03 -0.14258125D-03
    36  0.16261422D-03  0.71727153D-03
    37  0.10872451D-03  0.12325979D-02
    38 -0.11595613D-04 -0.41681566D-03
    39 -0.63872134D-04 -0.44257570D-02
    40 -0.10320916D-03 -0.94538181D-02
    41 -0.93425003D-04 -0.13989513D-01
    42 -0.12333649D-04 -0.30925463D-02
    43  0.16966648D-04  0.65797140D-02
    44  0.65870876D-04  0.37051037D-01
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.106994410000000000000000000000D+10 0.545208463379060564269829383677D-06     1
 
  NEW TEST RESULT      =
 0.106994410000000000000000000000D+10 0.545208463379086610532957453412D-06     1
 
  DIFFERENCE           =
 0.000000000000000000000000000000D+00 0.260462631280697354263509168959D-19     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE  5
 
 TEST DELTA INITIALIZATION CAPABILITIES
 AND USE OF ISTOPF TO RESTRICT PARAMETER VALUES FOR ODR PROBLEM
 WITH ANALYTIC DERIVATIVES USING DODRC.
 DATA SET REFERENCE:  BOGGS, BYRD AND SCHNABEL, 1985, EXAMPLE 1
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF ODR
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                               40
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS          40
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     1
 NUMBER OF FUNCTION PARAMETERS                         2
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 2
 
 
 
 INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:
 ----------------------------------------------
 
                               COLUMN   1
                           OBS 1        OBS N
               X -  -0.21370D-01  0.19933D+01
           FIXED -            NO           NO
   INITIAL DELTA -   0.00000D+00  0.00000D+00
     DELTA SCALE -   0.20000D+01  0.20000D+01
   DELTA WEIGHTS -   0.10000D+01  0.10000D+01
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -  -0.11957D+01  0.12617D+01
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2
 INITIAL BETA -   0.10000000D+01  0.10000000D+01
        FIXED -               NO              NO
   BETA SCALE -   0.20000000D+00  0.10000000D+01
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  01010        15  0.10D+01  0.15D-07  0.37D-10     50
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE INITIALIZED BY USER.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE SUPPLIED BY USER.
      USER-SUPPLIED DERIVATIVES WERE CHECKED.
      THE DERIVATIVES APPEAR TO BE CORRECT.
  E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.21300300D+03
 SUM OF SQUARED WEIGHTED DELTAS                  0.22299864D-02
 SUM OF SQUARED WEIGHTED EPSILONS                0.21300077D+03
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF ODR
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    1      13  0.26186D+02   0.8771D+00   0.9918D+00  0.718D-01    NO
    2      19  0.26949D+01   0.8971D+00   0.9518D+00  0.537D-01    NO
    3      24  0.11496D+01   0.5734D+00   0.5813D+00  0.208D-01    NO
    4      28  0.10967D+01   0.4596D-01   0.4602D-01  0.404D-02    NO
    5      32  0.10891D+01   0.6980D-02   0.6978D-02  0.858D-03    NO
    6      37  0.10862D+01   0.2622D-02   0.2621D-02  0.336D-03    NO
    7      42  0.10851D+01   0.1028D-02   0.1028D-02  0.133D-03    NO
    8      46  0.10849D+01   0.2046D-03   0.2046D-03  0.266D-04    NO
    9      51  0.10848D+01   0.8171D-04   0.8171D-04  0.106D-04    NO
   10      56  0.10847D+01   0.3266D-04   0.3266D-04  0.425D-05    NO
   11      61  0.10847D+01   0.1306D-04   0.1306D-04  0.170D-05    NO
   12      64  0.10847D+01   0.1306D-05   0.1306D-05  0.170D-06    NO
   13      70  0.10847D+01   0.1045D-05   0.1045D-05  0.136D-06    NO
   14      73  0.10847D+01   0.1045D-06   0.1045D-06  0.136D-07    NO
   15      78  0.10847D+01   0.4180D-07   0.4180D-07  0.544D-08    NO
   16      84  0.10847D+01   0.1672D-08   0.1672D-08  0.218D-09    NO
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF ODR
 ======================================
 
 
 
 STOPPING CONDITION (INFO =    101):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 
 NOTE:
 
 THE RESULTS FROM ODRPACK ARE QUESTIONABLE BECAUSE
 
 THE MOST RECENTLY TRIED STEP WAS REJECTED BY THE
 USER AS INDICATED BY THE VALUE OF VARIABLE ISTOPF
 RETURNED FROM USER-SUPPLIED SUBROUTINE FUN.
 
 
                                       CONDITION
       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
              16         85         18 0.6203D+00           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.10847287D+01
 SUM OF SQUARED WEIGHTED DELTAS                  0.84001724D-02
 SUM OF SQUARED WEIGHTED EPSILONS                0.10763285D+01
 
 ESTIMATED RESIDUAL VARIANCE                     0.28545492D-01
 (   38 DEGREES OF FREEDOM)
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
             J          BETA(J)     STD. DEV. BETA(J)
             1   0.10100000D+01        0.54610774D-01
             2   0.10080651D+01        0.28682229D-01
 
 
 
 ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
 ---------------------------------------------------
 
     I      EPSILON(I)      DELTA(I,1)
     1  0.21384066D+00  0.77254676D-03
     2  0.22556030D+00  0.94112955D-03
     3  0.10449749D+00  0.54542566D-03
     4 -0.15087433D+00 -0.66893074D-03
     5 -0.25305972D+00 -0.14799579D-02
     6  0.10081986D+00  0.76139533D-03
     7 -0.20815357D+00 -0.14782722D-02
     8 -0.20702085D-01 -0.65643511D-04
     9  0.82994169D-01  0.90137371D-03
    10  0.83205321D-01  0.13127806D-02
    11 -0.27450813D-01 -0.16008898D-03
    12 -0.23169388D-01 -0.97700225D-04
    13  0.28066202D+00  0.64098334D-02
    14 -0.23338057D+00 -0.81810740D-02
    15  0.29088630D+00  0.10746943D-01
    16  0.55125004D-03  0.23085084D-02
    17 -0.85415379D-02  0.28744276D-02
    18 -0.31404326D-01 -0.26914690D-01
    19 -0.23300280D-01 -0.43595260D-01
    20 -0.12567838D-02  0.53282035D-01
    21 -0.19797459D-04  0.20392976D-01
    22  0.16130354D-02 -0.32707756D-02
    23  0.20379162D-01  0.40345932D-01
    24  0.37905960D-01  0.28927563D-02
    25  0.11536131D+00  0.15390699D-01
    26 -0.15926106D+00 -0.10953475D-01
    27 -0.40829803D+00 -0.14858163D-01
    28  0.13213575D+00  0.32479255D-02
    29  0.10561235D+00  0.20776715D-02
    30  0.91812855D-01  0.11452297D-02
    31 -0.57069265D-01 -0.10370842D-02
    32  0.35811193D+00  0.45491883D-02
    33  0.19590912D+00  0.20287132D-02
    34 -0.19295097D+00 -0.17644917D-02
    35 -0.17148546D-01 -0.28478211D-03
    36 -0.13714996D+00 -0.99750359D-03
    37 -0.20659836D+00 -0.12592594D-02
    38  0.32401177D-01  0.10179380D-03
    39  0.15424345D+00  0.57898907D-03
    40 -0.23559464D+00 -0.92308083D-03
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.142698815637725862082163530431D+01 0.108472868712743220065419791354D+01   101
 
  NEW TEST RESULT      =
 0.142698815635322628914138931577D+01 0.108472868747640438513712979329D+01   101
 
  DIFFERENCE           =
 0.240323316802459885366261005402D-10 0.348972184482931879756506532431D-09     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE  6
 
 TEST STIFF STOPPING CONDITIONS FOR UNSCALED ODR PROBLEM
 WITH ANALYTIC DERIVATIVES USING DODRC.
 DATA SET REFERENCE:  HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF ODR
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                               13
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS          13
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     2
 NUMBER OF FUNCTION PARAMETERS                         3
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 3
 
 
 
 INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:
 ----------------------------------------------
 
                               COLUMN   1                COLUMN   2
                           OBS 1        OBS N        OBS 1        OBS N
               X -   0.00000D+00  0.29000D+01  0.00000D+00  0.18000D+01
           FIXED -            NO           NO           NO           NO
   INITIAL DELTA -   0.00000D+00  0.00000D+00  0.00000D+00  0.00000D+00
     DELTA SCALE -   0.10000D+02  0.34483D+00  0.10000D+02  0.33333D+00
   DELTA WEIGHTS -   0.10000D+01  0.10000D+01  0.10000D+01  0.10000D+01
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -   0.29300D+01  0.98100D+01
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2               3
 INITIAL BETA -   0.30000000D+01  0.30000000D+01 -0.50000000D+00
        FIXED -               NO              NO              NO
   BETA SCALE -   0.33333333D+00  0.33333333D+00  0.33333333D+00
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  00010        15  0.10D+01  0.22D-13  0.22D-15      2
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE INITIALIZED TO ZERO.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE SUPPLIED BY USER.
      USER-SUPPLIED DERIVATIVES WERE CHECKED.
      THE DERIVATIVES APPEAR TO BE CORRECT.
  E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.17930508D+00
 SUM OF SQUARED WEIGHTED DELTAS                  0.00000000D+00
 SUM OF SQUARED WEIGHTED EPSILONS                0.17930508D+00
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF ODR
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    1      13  0.14822D-01   0.9173D+00   0.9167D+00  0.105D+01   YES
    2      14  0.14780D-01   0.2874D-02   0.2897D-02  0.269D-01   YES
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF ODR
 ======================================
 
 
 
 STOPPING CONDITION (INFO =      4):
 -----------------------------------
 
 MAXIMUM NUMBER OF ITERATIONS REACHED
 
                                       CONDITION
       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
               2         15          4 0.2281D+00           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.14779672D-01
 SUM OF SQUARED WEIGHTED DELTAS                  0.13389160D-01
 SUM OF SQUARED WEIGHTED EPSILONS                0.13905124D-02
 
 ESTIMATED RESIDUAL VARIANCE                     0.14779672D-02
 (   10 DEGREES OF FREEDOM)
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
             J          BETA(J)     STD. DEV. BETA(J)
             1   0.30212727D+01        0.36887566D-01
             2   0.29588335D+01        0.83318859D-01
             3  -0.52543271D+00        0.30452500D-01
 
 
 
 ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
 ---------------------------------------------------
 
     I      EPSILON(I)      DELTA(I,1)      DELTA(I,2)
     1  0.23071990D-02 -0.69501229D-02  0.35591065D-02
     2 -0.18256324D-01  0.55132025D-01 -0.16914324D-01
     3  0.21586476D-01 -0.65074400D-01  0.11658612D-01
     4  0.31241338D-02 -0.93540286D-02  0.99921329D-03
     5  0.64041532D-02 -0.19329534D-01  0.98682959D-02
     6  0.28227936D-02 -0.84860281D-02  0.25775633D-02
     7 -0.11911006D-01  0.35997432D-01 -0.65131655D-02
     8  0.57192617D-03 -0.16711050D-02  0.30126130D-03
     9 -0.22909059D-02  0.68901239D-02 -0.35429853D-02
    10 -0.52747995D-02  0.15936835D-01 -0.48603477D-02
    11 -0.13712070D-01  0.41421720D-01 -0.74992763D-02
    12  0.84341831D-02 -0.25412302D-01  0.45714272D-02
    13  0.96307387D-02 -0.29030592D-01  0.57946194D-02
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.426132182951397897596734765102D+01 0.147796721039842073042169801056D-01     4
 
  NEW TEST RESULT      =
 0.426132182951397897596734765102D+01 0.147796721039841639361300806854D-01     4
 
  DIFFERENCE           =
 0.000000000000000000000000000000D+00 0.433680868994201773602981120348D-16     0
 
 
 
 NEW STOPPING CONDITION AND EXPECTED STOPPING CONDITION AGREE,
 BUT INDICATE CONVERGENCE WAS NOT ATTAINED.
 NO FURTHER COMPARISONS WILL BE MADE BETWEEN NEW AND EXPECTED RESULTS.
1EXAMPLE  7
 
 TEST RESTART FOR UNSCALED ODR PROBLEM
 WITH ANALYTIC DERIVATIVES USING DODRC.
 DATA SET REFERENCE:  HIMMELBLAU, 1970, EXAMPLE 6.2-4, PAGE 188
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 RESTART OF FIT BY METHOD OF ODR
 ===============================
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF ODR
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    3      16  0.14780D-01   0.7336D-06   0.7486D-06  0.841D-03   YES
    4      17  0.14780D-01   0.4552D-09   0.4693D-09  0.243D-04   YES
    5      18  0.14780D-01   0.4425D-12   0.4537D-12  0.701D-06   YES
    6      19  0.14780D-01  -0.6850D-15   0.4718D-15  0.335D-07   YES
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF ODR
 ======================================
 
 
 
 STOPPING CONDITION (INFO =      1):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 
                                       CONDITION
       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
               6         20          9 0.2280D+00           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.14779661D-01
 SUM OF SQUARED WEIGHTED DELTAS                  0.13392301D-01
 SUM OF SQUARED WEIGHTED EPSILONS                0.13873605D-02
 
 ESTIMATED RESIDUAL VARIANCE                     0.14779661D-02
 (   10 DEGREES OF FREEDOM)
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
             J          BETA(J)     STD. DEV. BETA(J)
             1   0.30212247D+01        0.36886262D-01
             2   0.29588200D+01        0.83316569D-01
             3  -0.52538288D+00        0.30448902D-01
 
 
 
 ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
 ---------------------------------------------------
 
     I      EPSILON(I)      DELTA(I,1)      DELTA(I,2)
     1  0.22986990D-02 -0.69448862D-02  0.35666690D-02
     2 -0.18241253D-01  0.55110925D-01 -0.16917585D-01
     3  0.21554517D-01 -0.65121041D-01  0.11644852D-01
     4  0.31076969D-02 -0.93890508D-02  0.99837258D-03
     5  0.63905056D-02 -0.19307154D-01  0.98826815D-02
     6  0.28129008D-02 -0.84984056D-02  0.25821939D-02
     7 -0.11910569D-01  0.35984505D-01 -0.64963209D-02
     8  0.55980350D-03 -0.16912922D-02  0.30424180D-03
     9 -0.22890884D-02  0.69158505D-02 -0.35650902D-02
    10 -0.52764814D-02  0.15941436D-01 -0.48627008D-02
    11 -0.13711291D-01  0.41424893D-01 -0.74823551D-02
    12  0.84120397D-02 -0.25414662D-01  0.45615579D-02
    13  0.96077621D-02 -0.29027208D-01  0.57834834D-02
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.426127230714288618429463895154D+01 0.147796612546537437654636804041D-01     1
 
  NEW TEST RESULT      =
 0.426127230550321378643729985924D+01 0.147796612546536691723542134014D-01     1
 
  DIFFERENCE           =
 0.163967239785733909229747951031D-08 0.745931094670027050597127526999D-16     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE  8
 
 TEST USE OF TAUFAC TO RESTRICT FIRST STEP FOR ODR PROBLEM
 WITH FINITE DIFFERENCE DERIVATIVES USING DODRC.
 DATA SET REFERENCE:  POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGES 153-154
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF ODR
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                               14
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS          14
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     1
 NUMBER OF FUNCTION PARAMETERS                         3
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 3
 
 
 
 INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:
 ----------------------------------------------
 
                               COLUMN   1
                           OBS 1        OBS N
               X -   0.10000D+01  0.14000D+02
           FIXED -            NO           NO
   INITIAL DELTA -   0.00000D+00  0.00000D+00
     DELTA SCALE -   0.10000D+01  0.71429D-01
   DELTA WEIGHTS -   0.10000D+01  0.10000D+01
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -   0.26380D+02  0.22220D+02
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2               3
 INITIAL BETA -   0.25000000D+02  0.30000000D+02  0.60000000D+01
        FIXED -               NO              NO              NO
   BETA SCALE -   0.33333333D-01  0.33333333D-01  0.33333333D-01
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  00200        15  0.10D-01  0.15D-07  0.37D-10     50
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE INITIALIZED TO ZERO.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL NOT BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE COMPUTED BY FINITE DIFFERENCES.
  E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.66518388D+02
 SUM OF SQUARED WEIGHTED DELTAS                  0.00000000D+00
 SUM OF SQUARED WEIGHTED EPSILONS                0.66518388D+02
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF ODR
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    1      19  0.16530D-02   0.1000D+01   0.1000D+01  0.191D+00   YES
    2      25  0.11444D-02   0.3077D+00   0.3077D+00  0.574D-02   YES
    3      31  0.11444D-02   0.2853D-05   0.2859D-05  0.449D-04   YES
    4      37  0.11444D-02   0.9187D-10   0.9551D-10  0.765D-06   YES
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF ODR
 ======================================
 
 
 
 STOPPING CONDITION (INFO =      1):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 
                             CONDITION
       NUMBER OF  NUMBER OF     NUMBER        RANK
      ITERATIONS   FN EVALS  (INVERSE)  DEFICIENCY
               4         38 0.5379D-02           0
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.11444195D-02
 SUM OF SQUARED WEIGHTED DELTAS                  0.12503306D-03
 SUM OF SQUARED WEIGHTED EPSILONS                0.10193864D-02
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
         INDEX            VALUE -------------->
     1 TO    3   0.27116749D+02  0.33642704D+02  0.66212191D+01
 
 
 
 ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:
 ---------------------------------------------------
 
     I      EPSILON(I)      DELTA(I,1)
     1  0.75980088D-02  0.49754064D-02
     2  0.73916414D-03  0.40657864D-03
     3 -0.69419662D-02 -0.32815811D-02
     4 -0.17131940D-01 -0.70839174D-02
     5 -0.78479213D-02 -0.28757569D-02
     6  0.38954447D-02  0.12796037D-02
     7  0.10856769D-01  0.32281389D-02
     8  0.72331159D-02  0.19628241D-02
     9  0.72270110D-02  0.18017788D-02
    10  0.76228838D-02  0.17561882D-02
    11  0.57454143D-02  0.12294168D-02
    12 -0.63416858D-03 -0.12660978D-03
    13 -0.37179098D-02 -0.69524195D-03
    14 -0.14659176D-01 -0.25768282D-02
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.437148731790976299294015916530D+02 0.114441947440828612793384255752D-02     1
 
  NEW TEST RESULT      =
 0.437148734934687155373467248864D+02 0.114441947440838348928893175582D-02     1
 
  DIFFERENCE           =
 0.314371085607945133233442902565D-06 0.973613550891982981738692615181D-16     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE  9
 
 TEST DETECTION OF QUESTIONABLE ANALYTIC DERIVATIVES FOR OLS PROBLEM
 USING DODRC.
 DATA SET REFERENCE:  POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGES 153-154
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 DERIVATIVE CHECKING REPORT FOR FIT BY METHOD OF OLS
 ===================================================
 
                                    *
                          DERIVATIVE
       DERIVATIVE WRT     ASSESSMENT
 
            BETA(  1)    QUESTIONABLE (3)
            BETA(  2)    QUESTIONABLE (3)
            BETA(  3)    QUESTIONABLE (3)
 
 *
  NUMBERS IN PARENTHESES REFER TO THE FOLLOWING NOTES.
 
  (3) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES
      DISAGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE
      USER-SUPPLIED DERIVATIVE IS IDENTICALLY ZERO.
 
 NUMBER OF RELIABLE DIGITS IN FUNCTION RESULTS          15
 
 NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN
 USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVE FOR
 USER-SUPPLIED DERIVATIVE TO BE CONSIDERED CORRECT       4
 
 ROW NUMBER AT WHICH DERIVATIVES WERE CHECKED            1
 
   -VALUES OF THE INDEPENDENT VARIABLES AT THIS ROW
 
      X( 1, 1)   0.10000000D+01
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 
 
 INITIAL SUMMARY FOR FIT BY METHOD OF OLS
 ========================================
 
 
 
 PROBLEM SIZE:
 -------------
 
 NUMBER OF OBSERVATIONS                               14
 NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS          14
 NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE     1
 NUMBER OF FUNCTION PARAMETERS                         3
 NUMBER OF UNFIXED FUNCTION PARAMETERS                 3
 
 
 
 INDEPENDENT VARIABLE SUMMARY:
 -----------------------------
 
                 COLUMN   1
             OBS 1        OBS N
 X -   0.10000D+01  0.14000D+02
 
 
 
 DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT SUMMARY:
 ----------------------------------------------------------
 
                           OBS 1        OBS N
               Y -   0.26380D+02  0.22220D+02
 OBS. ERROR WTS. -   0.10000D+01  0.10000D+01
 
 
 
 FUNCTION PARAMETER SUMMARY:
 ---------------------------
 
        INDEX -                1               2               3
 INITIAL BETA -   0.25000000D+02  0.30000000D+02  0.60000000D+01
        FIXED -               NO              NO              NO
   BETA SCALE -   0.33333333D-01  0.33333333D-01  0.33333333D-01
 
 
 
 CONTROL VALUES AND STOPPING CRITERIA:
 --------------------------------------
 
       *
    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT
  00011        15  0.10D+01  0.15D-07  0.37D-10     50
 
 *
  A.  FIT IS NOT A RESTART.
  B.  DELTAS ARE FIXED AT ZERO.
  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS
      WILL BE COMPUTED AT THE SOLUTION.
  D.  DERIVATIVES ARE SUPPLIED BY USER.
      USER-SUPPLIED DERIVATIVES WERE CHECKED.
      THE CORRECTNESS OF SOME OF THE DERIVATIVES IS
      QUESTIONABLE.  SEE ERROR MESSAGES FOR DETAILS.
  E.  FIT IS BY METHOD OF ORDINARY LEAST SQUARES.
 
 
 
 INITIAL SUMS OF SQUARES:
 ------------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.66518388D+02
 
 
 
 
 
 ITERATION REPORTS FOR FIT BY METHOD OF OLS
 ==========================================
 
 
         CUM.                 ACT. REL.   PRED. REL.
  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS              G-N
 NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION  TAU/PNORM  STEP
 ----  ------  -----------  -----------  -----------  ---------  ----
 
    1      14  0.66518D+02   0.4337D-16   0.0000D+00  0.000D+00   YES
 
 
 
 
 
 
 
 FINAL SUMMARY FOR FIT BY METHOD OF OLS
 ======================================
 
 
 
 STOPPING CONDITION (INFO =   1023):
 -----------------------------------
 
 THE RELATIVE CHANGE IN THE SUM OF THE SQUARED
 WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL
 AND
 THE RELATIVE CHANGE IN THE NORM OF BETA AND DELTA
 IS LESS THAN PARTOL
 
 NOTE:
 
 THE RESULTS FROM ODRPACK ARE QUESTIONABLE BECAUSE
 
 THE ODRPACK JACOBIAN MATRIX CHECKING PROCEDURE HAS
 DETERMINED THAT THE CORRECTNESS OF THE USER-SUPPLIED
 JACOBIAN MATRICES IS QUESTIONABLE, AND
 
 THE RESULTS OF THE MODEL FUNCTION AND/OR ITS
 DERIVATIVES ARE UNAFFECTED BY CHANGES IN THE UNFIXED
 FUNCTION PARAMETERS (BETA), INDICATING A PROBABLE
 ERROR IN USER-SUPPLIED SUBROUTINES FUN AND/OR JAC.
 
 
                                       CONDITION
       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER        RANK
      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)  DEFICIENCY
               1         15          2 0.0000D+00           3
 
 
 
 FINAL SUMS OF SQUARES:
 ----------------------
 
 SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS    0.66518388D+02
 
 
 
 ESTIMATED BETA(J), J = 1, ..., NP:
 ----------------------------------
 
 N.B. STANDARD ERRORS OF THE ESTIMATED BETAS WERE NOT
      COMPUTED BECAUSE EITHER THE JACOBIAN IS NOT FULL
      RANK AT THE SOLUTION, OR THE MOST RECENTLY TRIED
      VALUES OF BETA AND/OR X+DELTA WERE UNACCEPTABLE.
 
         INDEX            VALUE -------------->
     1 TO    3   0.25000000D+02  0.30000000D+02  0.60000000D+01
 
 
 
 ESTIMATED EPSILON(I), I = 1, ..., N:
 ------------------------------------
 
         INDEX            VALUE -------------->
     1 TO    4  -0.21282471D+01 -0.21533820D+01 -0.21736101D+01 -0.21929715D+01
     5 TO    8  -0.21875320D+01 -0.21785356D+01 -0.21741444D+01 -0.21804623D+01
     9 TO   12  -0.21821673D+01 -0.21829206D+01 -0.21856378D+01 -0.21926777D+01
    13 TO   14  -0.21959733D+01 -0.22071284D+01
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.395094925302768231745176308323D+02 0.665183875083491074065022985451D+02  1023
 
  NEW TEST RESULT      =
 0.395094925302768231745176308323D+02 0.665183875083490931956475833431D+02  1023
 
  DIFFERENCE           =
 0.000000000000000000000000000000D+00 0.142108547152020037174224853516D-13     0
 
 
 
 NEW RESULTS AND EXPECTED RESULTS AGREE TO WITHIN STOPPING TOLERANCE
 OF NEW RESULTS.
1EXAMPLE 10
 
 TEST DETECTION OF INCORRECT ANALYTIC DERIVATIVES FOR ODR PROBLEM
 WITH ANALYTIC DERIVATIVES USING DODRC.
 DATA SET REFERENCE:  POWELL AND MACDONALD, 1972, TABLES 7 & 8, PAGES 153-154
 
 
 
 *******************************************************
 * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) *
 *******************************************************
 
 
 
 DERIVATIVE CHECKING REPORT FOR FIT BY METHOD OF ODR
 ===================================================
 
                                    *
                          DERIVATIVE
       DERIVATIVE WRT     ASSESSMENT
 
            BETA(  1)    QUESTIONABLE (3)
            BETA(  2)    QUESTIONABLE (3)
            BETA(  3)    QUESTIONABLE (3)
             X( 1, 1)      INCORRECT
 
 *
  NUMBERS IN PARENTHESES REFER TO THE FOLLOWING NOTES.
 
  (3) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES
      DISAGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE
      USER-SUPPLIED DERIVATIVE IS IDENTICALLY ZERO.
 
 NUMBER OF RELIABLE DIGITS IN FUNCTION RESULTS          15
 
 NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN
 USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVE FOR
 USER-SUPPLIED DERIVATIVE TO BE CONSIDERED CORRECT       4
 
 ROW NUMBER AT WHICH DERIVATIVES WERE CHECKED            1
 
   -VALUES OF THE INDEPENDENT VARIABLES AT THIS ROW
 
      X( 1, 1)   0.10000000D+01
 
 
 *** COMPARISON OF NEW RESULTS WITH DOUBLE PRECISION CDC CYBER 205 RESULT ***
 
                         NORM OF BETA        SUM OF SQUARED WTD OBS ERRORS  INFO
 
  CDC CYBER 205 RESULT =
 0.395094925302768231745176308323D+02 0.665183875083491074065022985451D+02 40100
 
  NEW TEST RESULT      =
 0.395094925302768231745176308323D+02 0.665183875083490931956475833431D+02 40100
 
  DIFFERENCE           =
 0.000000000000000000000000000000D+00 0.142108547152020037174224853516D-13     0
 
 
 
 NEW STOPPING CONDITION AND EXPECTED STOPPING CONDITION AGREE,
 BUT INDICATE CONVERGENCE WAS NOT ATTAINED.
 NO FURTHER COMPARISONS WILL BE MADE BETWEEN NEW AND EXPECTED RESULTS.
*DACCES
      SUBROUTINE DACCES
     +   (N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +   ACCESS,
     +   JPVT,WRK1,TFJACB,OMEGA,YT,U,QRAUX,WRK2,
     +   NNZW,NPP,
     +   JOB,PARTOL,SSTOL,MAXIT,TAUFAC,EPSMAC,NETA,
     +   LUNRPT,IPR1,IPR2,IPR2F,IPR3,
     +   WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +   TAU,ALPHA,NITER,NFEV,NJEV,INT2,OLMAVG,
     +   RCOND,IRANK,ACTRS,PNORM,PRERS,RNORMS)
C***BEGIN PROLOGUE  DACCES
C***REFER TO DODR,DODRC
C***ROUTINES CALLED  DIWINF,DWINF
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  ACCESS OR STORE VALUES IN THE WORK ARRAYS
C***END PROLOGUE  DACESS
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   ACTRS,ALPHA,EPSMAC,OLMAVG,PARTOL,PNORM,PRERS,RCOND,
     +   RNORMS,RVAR,SSTOL,TAU,TAUFAC,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IDF,INT2,IPR1,IPR2,IPR2F,IPR3,IRANK,JOB,JPVT,LIWORK,LUNRPT,
     +   LWORK,M,MAXIT,N,NETA,NFEV,NITER,NJEV,NNZW,NP,NPP,OMEGA,
     +   QRAUX,TFJACB,U,WRK1,WRK2,YT
      LOGICAL
     +   ACCESS
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   WORK(LWORK)
      INTEGER
     +   IWORK(LIWORK)
*
C...LOCAL SCALARS
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSMAI,ETAI,FI,FJACBI,FJACXI,FNI,FSI,IDFI,INT2I,IPRINI,IPRINT,
     +   IRANKI,JOBI,JPVTI,LDTTI,LIWKMN,LUNERI,LUNRPI,LWKMN,MAXITI,
     +   MSGB,MSGX,NETAI,NFEVI,NITERI,NJEVI,NNZWI,NPPI,NROWI,NTOLI,
     +   OLMAVI,OMEGAI,PARTLI,PNORMI,PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,
     +   SI,SSFI,SSI,SSSI,SSTOLI,TAUFCI,TAUI,TFJACI,TI,TTI,UI,WRK1I,
     +   WRK2I,WSSI,WSSDEI,WSSEPI,XPLUSI,YTI
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DIWINF,DWINF
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION ACTRS
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER FI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER INT2
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPR1
C        THE VALUE OF THE FOURTH DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE INITIAL SUMMARY REPORT.
C     INTEGER IPR2
C        THE VALUE OF THE THIRD DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE ITERATION REPORTS.
C     INTEGER IPR2F
C        THE VALUE OF THE SECOND DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FREQUENCY OF THE ITERATION REPORTS.
C     INTEGER IPR3
C        THE VALUE OF THE FIRST DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FINAL SUMMARY REPORT.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVT
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY DJCK.
C     DOUBLE PRECISION OLMAVG
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGA
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     DOUBLE PRECISION PRERS
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUX
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     DOUBLE PRECISION RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     DOUBLE PRECISION RNORMS
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION RVAR
C        THE RESIDUAL VARIANCE, I.E. STANDARD DEVIATION SQUARED.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE, I.E. STANDARD DEVIATION SQUARED.
C     DOUBLE PRECISION SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION TAU
C        THE TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     INTEGER TFJACB
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER TFJACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     INTEGER U
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     DOUBLE PRECISION WORK(LWORK)
C        THE DOUBLE PRECISION WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     DOUBLE PRECISION WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     DOUBLE PRECISION WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     DOUBLE PRECISION WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     INTEGER YT
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     INTEGER YTI
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
*
*
C***FIRST EXECUTABLE STATEMENT  DACCES
*
*
C  FIND STARTING LOCATIONS WITHIN INTEGER WORKSPACE
*
      CALL DIWINF(M,NP,
     +            MSGB,MSGX,JPVTI,
     +            NNZWI,NPPI,IDFI,
     +            JOBI,IPRINI,LUNERI,LUNRPI,
     +            NROWI,NTOLI,NETAI,
     +            MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +            LIWKMN)
*
C  FIND STARTING LOCATIONS WITHIN DOUBLE PRECISION WORK SPACE
*
      CALL DWINF(N,M,NP,
     +           DELTAI,FI,
     +           WSSI,WSSDEI,WSSEPI,RVARI,
     +           PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +           FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +           DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +           ALPHAI,TFJACI,OMEGAI,YTI,UI,QRAUXI,WRK1I,WRK2I,RCONDI,
     +           ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +           LWKMN)
*
      IF (ACCESS) THEN
*
C  SET STARTING LOCATIONS FOR WORK VECTORS
*
         JPVT   = JPVTI
         WRK1   = WRK1I
         TFJACB = TFJACI
         OMEGA  = OMEGAI
         YT     = YTI
         U      = UI
         QRAUX  = QRAUXI
         WRK2   = WRK2I
*
C  ACCESS VALUES FROM THE WORK VECTORS
*
         ACTRS  = WORK(ACTRSI)
         ALPHA  = WORK(ALPHAI)
         EPSMAC = WORK(EPSMAI)
         OLMAVG = WORK(OLMAVI)
         PARTOL = WORK(PARTLI)
         PNORM  = WORK(PNORMI)
         PRERS  = WORK(PRERSI)
         RCOND  = WORK(RCONDI)
         WSS    = WORK(WSSI)
         WSSDEL = WORK(WSSDEI)
         WSSEPS = WORK(WSSEPI)
         RVAR   = WORK(RVARI)
         RNORMS = WORK(RNORSI)
         SSTOL  = WORK(SSTOLI)
         TAU    = WORK(TAUI)
         TAUFAC = WORK(TAUFCI)
*
         NETA   = IWORK(NETAI)
         IRANK  = IWORK(IRANKI)
         JOB    = IWORK(JOBI)
         LUNRPT = IWORK(LUNRPI)
         MAXIT  = IWORK(MAXITI)
         NFEV   = IWORK(NFEVI)
         NITER  = IWORK(NITERI)
         NJEV   = IWORK(NJEVI)
         NNZW   = IWORK(NNZWI)
         NPP    = IWORK(NPPI)
         IDF    = IWORK(IDFI)
         INT2   = IWORK(INT2I)
*
C  SET UP PRINT CONTROL VARIABLES
*
         IPRINT = IWORK(IPRINI)
*
         IPR1   = MOD(IPRINT,10000)/1000
         IPR2   = MOD(IPRINT,1000)/100
         IPR2F  = MOD(IPRINT,100)/10
         IPR3   = MOD(IPRINT,10)
*
      ELSE
*
C  STORE VALUES INTO THE WORK VECTORS
*
         WORK(ACTRSI)  = ACTRS
         WORK(ALPHAI)  = ALPHA
         WORK(OLMAVI)  = OLMAVG
         WORK(PARTLI)  = PARTOL
         WORK(PNORMI)  = PNORM
         WORK(PRERSI)  = PRERS
         WORK(RCONDI)  = RCOND
         WORK(WSSI)    = WSS
         WORK(WSSDEI)  = WSSDEL
         WORK(WSSEPI)  = WSSEPS
         WORK(RVARI)   = RVAR
         WORK(RNORSI)  = RNORMS
         WORK(SSTOLI)  = SSTOL
         WORK(TAUI)    = TAU
*
         IWORK(IRANKI) = IRANK
         IWORK(NFEVI)  = NFEV
         IWORK(NITERI) = NITER
         IWORK(NJEVI)  = NJEV
         IWORK(IDFI)   = IDF
         IWORK(INT2I)  = INT2
      END IF
*
      RETURN
      END
*DDIAGI
      SUBROUTINE DDIAGI
     +   (N,M,S,LDS,V,LDV,SV,LDSV)
C***BEGIN PROLOGUE  DDIAGI
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE THE VECTOR V BY THE INVERSE OF THE DIAGONAL MATRIX S
C            AND RETURN THE RESULT IN VECTOR SV
C***END PROLOGUE  DDIAGI
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDS,LDSV,LDV,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   S(LDS,M),SV(LDSV,M),V(LDV,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDS
C        THE LEADING DIMENSION OF ARRAY S.
C     INTEGER LDSV
C        THE LEADING DIMENSION OF ARRAY SV.
C     INTEGER LDV
C        THE LEADING DIMENSION OF ARRAY V.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION S(LDS,M)
C        THE SCALING ARRAY.
C     DOUBLE PRECISION SV(LDSV,M)
C        THE INVERSE SCALED ARRAY.
C     DOUBLE PRECISION V(LDV,M)
C        THE ARRAY BEING SCALED.
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DDIAGI
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (S(1,1).LT.ZERO) THEN
         DO 20 J=1,M
            DO 10 I = 1,N
               SV(I,J) = V(I,J)/ABS(S(1,1))
   10       CONTINUE
   20    CONTINUE
      ELSE
         IF (LDS.EQ.1) THEN
            DO 40 J=1,M
               DO 30 I=1,N
                  SV(I,J) = V(I,J)/S(1,J)
   30          CONTINUE
   40       CONTINUE
         ELSE
            DO 60 J=1,M
               DO 50 I=1,N
                  SV(I,J) = V(I,J)/S(I,J)
   50          CONTINUE
   60       CONTINUE
         END IF
      END IF
*
      RETURN
      END
*DDIAGS
      SUBROUTINE DDIAGS
     +   (N,M,S,LDS,V,LDV,SV,LDSV)
C***BEGIN PROLOGUE  DDIAGS
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE THE VECTOR V BY THE DIAGONAL MATRIX S
C            AND RETURN THE RESULT IN VECTOR SV.
C***END PROLOGUE  DDIAGS
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDS,LDSV,LDV,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   S(LDS,M),SV(LDSV,M),V(LDV,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDS
C        THE LEADING DIMENSION OF ARRAY S.
C     INTEGER LDSV
C        THE LEADING DIMENSION OF ARRAY SV.
C     INTEGER LDV
C        THE LEADING DIMENSION OF ARRAY V.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION S(LDS,M)
C        THE SCALING ARRAY.
C     DOUBLE PRECISION SV(LDSV,M)
C        THE SCALED ARRAY.
C     DOUBLE PRECISION V(LDV,M)
C        THE ARRAY BEING SCALED.
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DDIAGS
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (S(1,1).LT.ZERO) THEN
         DO 20 J=1,M
            DO 10 I=1,N
               SV(I,J) = ABS(S(1,1))*V(I,J)
   10       CONTINUE
   20    CONTINUE
      ELSE
         IF (LDS.EQ.1) THEN
            DO 40 J=1,M
               DO 30 I=1,N
                  SV(I,J) = S(1,J)*V(I,J)
   30          CONTINUE
   40       CONTINUE
         ELSE
            DO 60 J=1,M
               DO 50 I=1,N
                  SV(I,J) = S(I,J)*V(I,J)
   50          CONTINUE
   60       CONTINUE
         END IF
      END IF
*
      RETURN
      END
*DDIAGW
      SUBROUTINE DDIAGW
     +   (N,M,W,V,LDV,WV,LDWV)
C***BEGIN PROLOGUE  DDIAGW
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE THE N BY M ARRAY V BY THE DIAGONAL OBSERVATIONAL
C            ERROR WEIGHT MATRIX W AND RETURN THE RESULT IN VECTOR WV.
C            N.B.  IF THE FIRST ELEMENT OF W IS NEGATIVE, THE DEFAULT
C            WEIGHTING OF ONE FOR ALL ELEMENTS WILL BE INVOKED, I.E.,
C            THE RESULTS WILL BE "UNWEIGHTED."
C***END PROLOGUE  DDIAGW
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDV,LDWV,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   V(LDV,M),W(N),WV(LDWV,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ZERO
      INTEGER
     +   I,J
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDV
C        THE LEADING DIMENSION OF ARRAY V.
C     INTEGER LDWV
C        THE LEADING DIMENSION OF ARRAY WV.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION V(LDV,M)
C        THE ARRAY BEING WEIGHTED.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C     DOUBLE PRECISION WV(LDWV,M)
C        THE WEIGHTED ARRAY.
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DDIAGW
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (W(1).LT.ZERO) THEN
         DO 20 J=1,M
            DO 10 I=1,N
               WV(I,J) = V(I,J)
   10       CONTINUE
   20    CONTINUE
      ELSE
         DO 40 J=1,M
            DO 30 I=1,N
               WV(I,J) = W(I)*V(I,J)
   30       CONTINUE
   40    CONTINUE
      END IF
*
      RETURN
      END
*DETAF
      SUBROUTINE DETAF
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,NETA,EPSMAC,
     +   NROW,PARTMP,PVTEMP,ISTOP)
C***BEGIN PROLOGUE  DETAF
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE NOISE AND NUMBER OF GOOD DIGITS IN FUNCTION RESULTS
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE ETAFUN)
C***END PROLOGUE  DETAF
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   EPSMAC,ETA
      INTEGER
     +   ISTOP,LDXPD,M,N,NETA,NFEV,NP,NROW
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),PARTMP(NP),PVTEMP(N),XPLUSD(LDXPD,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   A,B,FAC,J,ONE,P1,P2,RSSSM,RSSSMJ,SQRTMP,ZERO
      INTEGER
     +   I,K
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   RSS(5)
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,INT,LOG10,MAX,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P1,P2,ONE
     +   /0.0D0,0.1D0,0.2D0,1.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION A
C        PARAMETERS OF THE FIT.
C     DOUBLE PRECISION B
C        PARAMETERS OF THE FIT.
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION ETA
C        THE NOISE IN THE MODEL RESULTS.
C     DOUBLE PRECISION FAC
C        A FACTOR USED IN THE COMPUTATIONS.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     DOUBLE PRECISION J
C        THE VALUE FLOAT(I-3).
C     INTEGER K
C        AN INDEX VARIABLE.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE MODEL RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION P1
C        THE VALUE 0.1D0.
C     DOUBLE PRECISION P2
C        THE VALUE 0.2D0.
C     DOUBLE PRECISION PARTMP(NP)
C        MODIFIED MODEL PARAMETERS
C     DOUBLE PRECISION PVTEMP(N)
C        PREDICTED VALUES
C     DOUBLE PRECISION RSS(5)
C        THE RESIDUAL SUM OF SQUARES FOR EACH VALUE OF J.
C     DOUBLE PRECISION RSSSM
C        THE SUM OF THE RESIDUAL SUM OF SQUARES FOR EACH SET OF
C        PARAMETER VALUES.
C     DOUBLE PRECISION RSSSMJ
C        THE SUM OF THE RESIDUAL SUM OF SQUARES TIMES J FOR EACH
C        SET OF PARAMETER VALUES.
C     DOUBLE PRECISION SQRTMP
C        THE SQUARE ROOT OF MACHINE PRECISION (EPSMAC).
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DETAF
*
*
      SQRTMP = SQRT(EPSMAC)
      RSSSM = ZERO
      RSSSMJ = ZERO
      DO 20 I=1,5
         J = I-3
         DO 10 K=1,NP
            PARTMP(K) = BETA(K)*(ONE+J*SQRTMP)
   10    CONTINUE
         ISTOP = 0
         CALL FUN(N,NP,M,PARTMP,XPLUSD,LDXPD,PVTEMP,ISTOP)
         NFEV = NFEV + 1
         IF (ISTOP.NE.0) THEN
            RETURN
         END IF
*
         RSS(I) = PVTEMP(NROW)
*
         RSSSM = RSSSM + RSS(I)
         RSSSMJ = RSSSMJ + J*RSS(I)
   20 CONTINUE
      A = P2*RSSSM
      B = P1*RSSSMJ
      IF (RSS(3).NE.ZERO) THEN
         FAC = ONE/ABS(RSS(3))
      ELSE
         FAC = ONE
      END IF
      DO 30 I=1,5
         J = I-3
         RSS(I) = ABS((RSS(I)-(A+J*B))*FAC)
   30 CONTINUE
      ETA = MAX(RSS(1),RSS(2),RSS(3),RSS(4),RSS(5),EPSMAC)
      NETA = INT(-LOG10(ETA))
*
      RETURN
      END
*DEVFUN
      SUBROUTINE DEVFUN
     +   (N,NP,M,BETAC,BETA,IFIXB,FUN,
     +   X,LDX,Y,DELTA,LDDELT,XPLUSD,LDXPD,
     +   W,F,NFEV,ISTOP)
C***BEGIN PROLOGUE  DEVFUN
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DAXPY,DDIAGW,DUNPAC,DXPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE THE WEIGHTED EPSILON'S FOR THE CURRENT POINT
C***END PROLOGUE  DEVFUN
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOP,LDDELT,LDX,LDXPD,M,N,NFEV,NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),BETAC(NP),DELTA(LDDELT,M),F(N),W(N),
     +   X(LDX,M),XPLUSD(LDXPD,M),Y(N)
      INTEGER
     +   IFIXB(NP)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   NEGONE
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DAXPY,DDIAGW,DUNPAC,DXPY
*
C...DATA STATEMENTS
      DATA
     +   NEGONE
     +   /-1.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION BETAC(NP)
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     DOUBLE PRECISION DELTA(LDDELT,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     DOUBLE PRECISION F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     INTEGER LDDELT
C        THE LEADING DIMENSION OF ARRAY DELTA.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION NEGONE
C        THE VALUE -1.0D0.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  DEVFUN
*
*
C  INSERT CURRENT UNFIXED BETA ESTIMATES INTO BETA
*
      CALL DUNPAC(NP,BETAC,BETA,IFIXB)
*
C  COMPUTE XPLUSD = X + DELTA
*
      CALL DXPY(N,M,X,LDX,DELTA,LDDELT,XPLUSD,LDXPD)
*
C  EVALUATE THE PREDICTED VALUES OF THE FUNCTION FOR THE CURRENT POINT
*
      ISTOP = 1
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOP)
      IF (ISTOP.LT.0) THEN
         RETURN
      END IF
*
C  INCREMENT COUNT OF NUMBER OF FUNCTION EVALUATIONS
*
      NFEV = NFEV + 1
*
C  COMPUTE WEIGHTED EPSILONS FOR CURRENT POINT AND STORE IN F
*
      CALL DAXPY(N,NEGONE,Y,1,F,1)
      CALL DDIAGW(N,1,W,F,N,F,N)
*
      RETURN
      END
*DEVJAC
      SUBROUTINE DEVJAC
     +   (FUN,JAC,ANAJAC,
     +   N,NP,NPP,M,BETAC,BETA,IFIXB,IFIXX,LDIFX,
     +   X,LDX,DELTA,LDDELT,XPLUSD,LDXPD,
     +   SS,TT,LDTT,NETA,PV,STP,
     +   FJACB,LDFJB,ISODR,FJACX,LDFJX,W,NJEV,NFEV,ISTOP)
C***BEGIN PROLOGUE  DEVJAC
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DDIAGW,DJACFD,DUNPAC,DXPY,DZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE THE WEIGHTED JACOBIANS WRT BETA AND DELTA
C***END PROLOGUE  DEVJAC
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOP,LDDELT,LDFJB,LDFJX,LDIFX,LDTT,LDX,LDXPD,M,N,NETA,NFEV,
     +   NJEV,NP,NPP
      LOGICAL
     +   ANAJAC,ISODR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),BETAC(NP),DELTA(LDDELT,M),
     +   FJACB(LDFJB,NP),FJACX(LDFJX,M),PV(N),SS(NP),
     +   STP(N),TT(LDTT,M),W(N),X(LDX,M),XPLUSD(LDXPD,M)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ZERO
      INTEGER
     +   I,J,JFX
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DDIAGW,DJACFD,DUNPAC,DXPY,DZERO
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION BETAC(NP)
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     DOUBLE PRECISION DELTA(LDDELT,M)
C        THE ESTIMATED VALUES OF DELTA.
C     DOUBLE PRECISION FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     DOUBLE PRECISION FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JFX
C        AN INDEXING VARIABLE.
C     INTEGER LDDELT
C        THE LEADING DIMENSION OF ARRAY DELTA.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION PV(N)
C        THE PREDICTED VALUES OF THE FUNCTION AT THE CURRENT
C        POINT.
C     DOUBLE PRECISION SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION STP(N)
C        THE STEP USED TO COMPUTE FINITE DIFFERENCE DERIVATIVES.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DEVJAC
*
*
C  INSERT CURRENT UNFIXED BETA ESTIMATES INTO BETA
*
      CALL DUNPAC(NP,BETAC,BETA,IFIXB)
*
C  COMPUTE XPLUSD = X + DELTA
*
      CALL DXPY(N,M,X,LDX,DELTA,LDDELT,XPLUSD,LDXPD)
*
C  COMPUTE THE JACOBIAN WRT THE ESTIMATED BETAS (FJACB) AND
C          THE JACOBIAN WRT DELTA (FJACX)
*
      ISTOP = 1
      IF (ANAJAC) THEN
         CALL JAC(N,NP,M,BETA,XPLUSD,LDXPD,
     +            FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOP)
         NJEV = NJEV+1
      ELSE
         CALL DJACFD(N,NP,M,BETA,
     +               X,LDX,DELTA,XPLUSD,LDXPD,FUN,
     +               SS,TT,LDTT,NETA,PV,STP,
     +               IFIXB,FJACB,LDFJB,ISODR,
     +               IFIXX,LDIFX,FJACX,LDFJX,NFEV,ISTOP)
      END IF
      IF (ISTOP.LT.0) THEN
         RETURN
      END IF
*
C  WEIGHT THE JACOBIAN WRT THE ESTIMATED BETAS
*
      IF (ANAJAC) THEN
         JFX = 0
         IF (IFIXB(1).GE.0) THEN
            DO 10 J=1,NP
               IF (IFIXB(J).NE.0) THEN
                  JFX = JFX + 1
                  CALL DDIAGW(N,1,W,FJACB(1,J),LDFJB,
     +                        FJACB(1,JFX),LDFJB)
               END IF
   10       CONTINUE
         ELSE
            DO 20 J=1,NP
               CALL DDIAGW(N,1,W,FJACB(1,J),LDFJB,
     +                     FJACB(1,J),LDFJB)
   20       CONTINUE
         END IF
      ELSE
         DO 30 J=1,NPP
            CALL DDIAGW(N,1,W,FJACB(1,J),LDFJB,
     +                  FJACB(1,J),LDFJB)
   30    CONTINUE
      END IF
*
C  WEIGHT OR ZERO THE JACOBIAN'S WRT X AS APPROPRIATE
*
      IF (ISODR) THEN
         IF (IFIXX(1,1).GE.0) THEN
*
C  CHECK FOR POSSIBLY FIXED COLUMNS OR ELEMENTS OF X
*
            IF (LDIFX.EQ.1) THEN
               DO 40 J=1,M
                  IF (IFIXX(1,J).EQ.0) THEN
*
C  ZERO JACOBIAN WRT X(I,J) FOR I=1,N
*
                     CALL DZERO(N,1,FJACX(1,J),LDFJX)
                  ELSE
*
C  WEIGHT JACOBIAN WRT X(I,J) FOR I=1,N
*
                     CALL DDIAGW(N,1,W,FJACX(1,J),LDFJX,
     +                           FJACX(1,J),LDFJX)
                  END IF
   40          CONTINUE
            ELSE
*
C  WEIGHT JACOBIAN WRT X(I,J) FOR I=1,N AND
C  THEN ZERO APPROPRIATE ELEMENTS
*
               DO 60 J=1,M
                  CALL DDIAGW(N,1,W,FJACX(1,J),LDFJX,
     +                        FJACX(1,J),LDFJX)
                  DO 50 I=1,N
                     IF (IFIXX(I,J).EQ.0) THEN
                        FJACX(I,J) = ZERO
                     END IF
   50             CONTINUE
   60          CONTINUE
            END IF
         ELSE
*
C  WEIGHT JACOBIAN WRT X(I,J) FOR I=1,N AND J=1,M
*
            DO 70 J=1,M
               CALL DDIAGW(N,1,W,FJACX(1,J),LDFJX,
     +                     FJACX(1,J),LDFJX)
   70       CONTINUE
         END IF
      ELSE
*
C  ZERO ALL ELEMENTS OF FJACX FOR OLS FIT
*
         CALL DZERO(N,M,FJACX,LDFJX)
      END IF
*
      RETURN
      END
*DFLAGS
      SUBROUTINE DFLAGS
     +   (JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
C***BEGIN PROLOGUE  DFLAGS
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET FLAGS INDICATING CONDITIONS SPECIFIED BY JOB
C***END PROLOGUE  DFLAGS
*
C...SCALAR ARGUMENTS
      INTEGER
     +   JOB
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...LOCAL SCALARS
      INTEGER
     +   J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        THE VALUE OF THE SECOND DIGIT (FROM THE RIGHT) OF JOB.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
*
*
C***FIRST EXECUTABLE STATEMENT  DFLAGS
*
*
      IF (JOB.GE.0) THEN
         RESTRT= JOB.GE.10000
         INITD = MOD(JOB,10000)/1000.EQ.0
         DOVCV = MOD(JOB,1000)/100.EQ.0
         J = MOD(JOB,100)/10
         IF (J.EQ.0) THEN
            ANAJAC = .FALSE.
            CHKJAC = .FALSE.
         ELSE IF (J.EQ.1) THEN
            ANAJAC = .TRUE.
            CHKJAC = .TRUE.
         ELSE
            ANAJAC = .TRUE.
            CHKJAC = .FALSE.
         END IF
         ISODR = MOD(JOB,10).EQ.0
      ELSE
         RESTRT  = .FALSE.
         INITD = .TRUE.
         DOVCV = .TRUE.
         ANAJAC = .FALSE.
         CHKJAC = .FALSE.
         ISODR = .TRUE.
      END IF
*
      RETURN
      END
*DIDTS
      SUBROUTINE DIDTS
     +   (N,M,W,WD,LDWD,ALPHA,TT,LDTT,T,LDT,DTT,LDDTT)
C***BEGIN PROLOGUE  DIDTS
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE MATRIX TT BY THE INVERSE OF DT, I.E., COMPUTE
C            DTT = T * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2,
C            W AND D ARE DEFINED BY EQ.2 OF THE PROLOGUE OF DODR
C            AND DODRC, AND TT IS THE SCALING MATRIX FOR THE DELTA'S,
C            ALSO DEFINED IN THE PROLOGUE OF DODR AND DODRC.
C***END PROLOGUE  DIDTS
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   ALPHA
      INTEGER
     +   LDDTT,LDT,LDTT,LDWD,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DTT(LDDTT,M),T(LDT,M),TT(LDTT,M),W(N),WD(LDWD,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   DT,ONE,TERM1,TERM2,ZERO
      INTEGER
     +   I,J
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0D0,1.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C   N.B. THE LOCATIONS OF W, WD AND TT ACCESSED DEPEND ON THE VALUE
C        OF THE FIRST ELEMENT OF EACH ARRAY AND THE LEADING DIMENSION
C        OF THE DOUBLY SUBSCRIPTED ARRAYS.
C     DOUBLE PRECISION ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     DOUBLE PRECISION DT
C        THE VALUE OF THE FACTOR DT = INV((W*D)**2+ALPHA*TT**2)
C     DOUBLE PRECISION DTT(LDDTT,M)
C        THE ARRAY DTT = T * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDDTT
C        THE LEADING DIMENSION OF ARRAY DTT.
C     INTEGER LDT
C        THE LEADING DIMENSION OF ARRAY T.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION T(LDT,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     DOUBLE PRECISION TERM1
C        THE VALUE OF THE TERM (W(I)*WD(I,J))**2
C     DOUBLE PRECISION TERM2
C        THE VALUE OF THE TERM ALPHA*TT(I,J)**2
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DIDTS
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (W(1).GE.ZERO) THEN
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 1120 J=1,M
                        DO 1110 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(I,J))**2 +
     +                                   ALPHA*TT(I,J)**2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1110                   CONTINUE
 1120                CONTINUE
                  ELSE
                     DO 1140 J=1,M
                        TERM2 = ALPHA*TT(1,J)**2
                        DO 1130 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(I,J))**2+TERM2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1130                   CONTINUE
 1140                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 1160 J=1,M
                     DO 1150 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/((W(I)*WD(I,J))**2+TERM2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1150                CONTINUE
 1160             CONTINUE
               END IF
            ELSE
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 1220 J=1,M
                        DO 1210 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(1,J))**2 +
     +                                   ALPHA*TT(I,J)**2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1210                   CONTINUE
 1220                CONTINUE
                  ELSE
                     DO 1240 J=1,M
                        TERM2 = ALPHA*TT(1,J)**2
                        DO 1230 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(1,J))**2+TERM2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1230                   CONTINUE
 1240                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 1260 J=1,M
                     DO 1250 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/((W(I)*WD(1,J))**2+TERM2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1250                CONTINUE
 1260             CONTINUE
               END IF
            END IF
         ELSE
            IF (TT(1,1).GT.ZERO) THEN
               IF (LDTT.GE.N) THEN
                  DO 1320 J=1,M
                     DO 1310 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/
     +                                ((W(I)*WD(1,1))**2 +
     +                                ALPHA*TT(I,J)**2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1310                CONTINUE
 1320             CONTINUE
               ELSE
                  DO 1340 J=1,M
                     TERM2 = ALPHA*TT(1,J)**2
                     DO 1330 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/((W(I)*WD(1,1))**2+TERM2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1330                CONTINUE
 1340             CONTINUE
               END IF
            ELSE
               TERM2 = ALPHA*TT(1,1)**2
               DO 1360 J=1,M
                  DO 1350 I=1,N
                     IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                        DTT(I,J) = T(I,J)/((W(I)*WD(1,1))**2+TERM2)
                     ELSE
                        DTT(I,J) = ZERO
                     END IF
 1350             CONTINUE
 1360          CONTINUE
            END IF
         END IF
      ELSE
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 2120 J=1,M
                        DO 2110 I=1,N
                           DTT(I,J) = T(I,J)/
     +                                (WD(I,J)**2 + ALPHA*TT(I,J)**2)
 2110                   CONTINUE
 2120                CONTINUE
                  ELSE
                     DO 2140 J=1,M
                        TERM2 = ALPHA*TT(1,J)**2
                        DO 2130 I=1,N
                           DTT(I,J) = T(I,J)/(WD(I,J)**2+TERM2)
 2130                   CONTINUE
 2140                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 2160 J=1,M
                     DO 2150 I=1,N
                        DTT(I,J) = T(I,J)/(WD(I,J)**2+TERM2)
 2150                CONTINUE
 2160             CONTINUE
               END IF
            ELSE
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 2220 J=1,M
                        TERM1 = WD(1,J)**2
                        DO 2210 I=1,N
                           DTT(I,J) = T(I,J)/(TERM1+ALPHA*TT(I,J)**2)
 2210                   CONTINUE
 2220                CONTINUE
                  ELSE
                     DO 2240 J=1,M
                        DT = ONE/(WD(1,J)**2+ALPHA*TT(1,J)**2)
                        DO 2230 I=1,N
                           DTT(I,J) = T(I,J)*DT
 2230                   CONTINUE
 2240                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 2260 J=1,M
                     TERM1 = WD(1,J)**2
                     DT = ONE/(TERM1+TERM2)
                     DO 2250 I=1,N
                        DTT(I,J) = T(I,J)*DT
 2250                CONTINUE
 2260             CONTINUE
               END IF
            END IF
         ELSE
            IF (TT(1,1).GT.ZERO) THEN
               IF (LDTT.GE.N) THEN
                  TERM1 = WD(1,1)**2
                  DO 2320 J=1,M
                     DO 2310 I=1,N
                        DTT(I,J) = T(I,J)/(TERM1 + ALPHA*TT(I,J)**2)
 2310                CONTINUE
 2320             CONTINUE
               ELSE
                  TERM1 = WD(1,1)**2
                  DO 2340 J=1,M
                     TERM2 = ALPHA*TT(1,J)**2
                     DT = ONE/(TERM1+TERM2)
                     DO 2330 I=1,N
                        DTT(I,J) = T(I,J)*DT
 2330                CONTINUE
 2340             CONTINUE
               END IF
            ELSE
               DT = ONE/(WD(1,1)**2+ALPHA*TT(1,1)**2)
               DO 2360 J=1,M
                  DO 2350 I=1,N
                     DTT(I,J) = T(I,J)*DT
 2350             CONTINUE
 2360          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
      END
*DINIWK
      SUBROUTINE DINIWK
     +   (N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   BETA,SCLB,
     +   SSTOL,PARTOL,MAXIT,TAUFAC,
     +   JOB,IPRINT,LUNERR,LUNRPT,
     +   EPSMAI,SSTOLI,PARTLI,MAXITI,TAUFCI,
     +   JOBI,IPRINI,LUNERI,LUNRPI,
     +   SSFI,TTI,LDTTI,DELTAI)
C***BEGIN PROLOGUE  DINIWK
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DFLAGS,DMPREC,DSCLB,DSCLD,DZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  INITIALIZE WORK VECTORS AS NECESSARY
C***END PROLOGUE  DINIWK
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   DELTAI,EPSMAI,IPRINI,IPRINT,JOB,JOBI,LDIFX,
     +   LDSCLD,LDTTI,LDX,LIWORK,LUNERI,LUNERR,LUNRPI,LUNRPT,LWORK,M,
     +   MAXIT,MAXITI,N,NP,PARTLI,SSFI,SSTOLI,TAUFCI,TTI
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),SCLB(NP),SCLD(LDSCLD,M),WORK(LWORK),X(LDX,M)
      INTEGER
     +   IFIXX(LDIFX,M),IWORK(LIWORK)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ONE,THREE,TWO,ZERO
      INTEGER
     +   I,J
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DMPREC
      EXTERNAL
     +   DMPREC
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DCOPY,DFLAGS,DSCLB,DSCLD,DZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TWO,THREE
     +   /0.0D0,1.0D0,2.0D0,3.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     INTEGER EPSMAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTTI
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     DOUBLE PRECISION SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     DOUBLE PRECISION THREE
C          THE VALUE 3.0D0.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     DOUBLE PRECISION TWO
C          THE VALUE 2.0D0.
C     DOUBLE PRECISION WORK(LWORK)
C        THE DOUBLE PRECISION WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DINIWK
*
*
      CALL DFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
*
C  STORE VALUE OF MACHINE PRECISION IN WORK VECTOR
*
      WORK(EPSMAI) = DMPREC()
*
C  SET TOLERANCE FOR STOPPING CRITERIA BASED ON THE CHANGE IN THE
C  PARAMETERS
*
      IF (PARTOL.LT.WORK(EPSMAI) .OR. PARTOL.GE.ONE) THEN
         WORK(PARTLI) = WORK(EPSMAI)**(TWO/THREE)
      ELSE
         WORK(PARTLI) = PARTOL
      END IF
*
C  SET TOLERANCE FOR STOPPING CRITERIA BASED ON THE CHANGE IN THE
C  SUM OF SQUARES OF THE WEIGHTED OBSERVATIONAL ERRORS
*
      IF (SSTOL.LT.WORK(EPSMAI) .OR. SSTOL.GE.ONE) THEN
         WORK(SSTOLI) = SQRT(WORK(EPSMAI))
      ELSE
         WORK(SSTOLI) = SSTOL
      END IF
*
C  SET FACTOR FOR COMPUTING TRUST REGION DIAMETER AT FIRST ITERATION
*
      IF (TAUFAC.LE.ZERO) THEN
         WORK(TAUFCI) = ONE
      ELSE
         WORK(TAUFCI) = TAUFAC
      END IF
*
C  SET MAXIMUM NUMBER OF ITERATIONS
*
      IF (MAXIT.LE.0) THEN
         IWORK(MAXITI) = 50
      ELSE
         IWORK(MAXITI) = MAXIT
      END IF
*
C  STORE PROBLEM INITIALIZATION AND COMPUTATIONAL METHOD CONTROL
C  VARIABLE
*
      IF (JOB.LE.0) THEN
         IWORK(JOBI) = 0
      ELSE
         IWORK(JOBI) = JOB
      END IF
*
C  SET PRINT CONTROL
*
      IF (IPRINT.LT.0) THEN
         IWORK(IPRINI) = 2001
      ELSE
         IWORK(IPRINI) = IPRINT
      END IF
*
C  SET LOGICAL UNIT NUMBER FOR ERROR MESSAGES
*
      IF (LUNERR.LT.0) THEN
         IWORK(LUNERI) = 6
      ELSE
         IWORK(LUNERI) = LUNERR
      END IF
*
C  SET LOGICAL UNIT NUMBER FOR COMPUTATION REPORTS
*
      IF (LUNRPT.LT.0) THEN
         IWORK(LUNRPI) = 6
      ELSE
         IWORK(LUNRPI) = LUNRPT
      END IF
*
C  COMPUTE SCALING FOR BETA'S AND DELTA'S
*
      IF (SCLB(1).LE.ZERO) THEN
         CALL DSCLB(NP,BETA,WORK(SSFI))
      ELSE
         CALL DCOPY(NP,SCLB,1,WORK(SSFI),1)
      END IF
      IF (SCLD(1,1).LE.ZERO) THEN
         IWORK(LDTTI) = N
         CALL DSCLD(N,M,X,LDX,WORK(TTI),IWORK(LDTTI))
      ELSE
         IF (LDSCLD.EQ.1) THEN
            IWORK(LDTTI) = 1
            CALL DCOPY(N,SCLD(1,1),1,WORK(TTI),1)
         ELSE
            IWORK(LDTTI) = N
            DO 10 J=1,M
               CALL DCOPY(N,SCLD(1,J),1,WORK(TTI+(J-1)*IWORK(LDTTI)),1)
   10       CONTINUE
         END IF
      END IF
*
C  INITIALIZE DELTA'S AS NECESSARY
*
      IF (ISODR) THEN
         IF (INITD) THEN
            CALL DZERO(N,M,WORK(DELTAI),N)
         ELSE
            IF (IFIXX(1,1).GE.0) THEN
               IF (LDIFX.EQ.1) THEN
                  DO 20 J=1,M
                     IF (IFIXX(1,J).EQ.0) THEN
                        CALL DZERO(N,1,WORK(DELTAI+(J-1)*N),N)
                     END IF
   20             CONTINUE
               ELSE
                  DO 40 J=1,M
                     DO 30 I=1,N
                        IF (IFIXX(I,J).EQ.0) THEN
                           WORK(DELTAI-1+I+(J-1)*N) = ZERO
                        END IF
   30                CONTINUE
   40             CONTINUE
               END IF
            END IF
         END IF
      ELSE
         CALL DZERO(N,M,WORK(DELTAI),N)
      END IF
*
      RETURN
      END
*DIWINF
      SUBROUTINE DIWINF
     +   (M,NP,
     +   MSGB,MSGX,JPVTI,
     +   NNZWI,NPPI,IDFI,
     +   JOBI,IPRINI,LUNERI,LUNRPI,
     +   NROWI,NTOLI,NETAI,
     +   MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +   LIWKMN)
C***BEGIN PROLOGUE  DIWINF
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET STORAGE LOCATIONS WITHIN INTEGER WORK SPACE
C***END PROLOGUE  DIWINF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   IDFI,INT2I,IPRINI,IRANKI,JOBI,JPVTI,LDTTI,LIWKMN,LUNERI,
     +   LUNRPI,M,MAXITI,MSGB,MSGX,NETAI,NFEVI,NITERI,NJEVI,NNZWI,NP,
     +   NPPI,NROWI,NTOLI
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY DJCK.
*
*
C***FIRST EXECUTABLE STATEMENT  DIWINF
*
*
      IF (NP.GE.1 .AND. M.GE.1) THEN
         MSGB   = 1
         MSGX   = MSGB   + NP+1
         JPVTI  = MSGX   + M+1
         NNZWI  = JPVTI  + NP
         NPPI   = NNZWI  + 1
         IDFI   = NPPI  + 1
         JOBI   = IDFI   + 1
         IPRINI = JOBI   + 1
         LUNERI = IPRINI + 1
         LUNRPI = LUNERI + 1
         NROWI  = LUNRPI + 1
         NTOLI  = NROWI  + 1
         NETAI  = NTOLI  + 1
         MAXITI = NETAI  + 1
         NITERI = MAXITI + 1
         NFEVI  = NITERI + 1
         NJEVI  = NFEVI  + 1
         INT2I  = NJEVI  + 1
         IRANKI = INT2I  + 1
         LDTTI  = IRANKI + 1
         LIWKMN = LDTTI
      ELSE
         MSGB   = 1
         MSGX   = 1
         JPVTI  = 1
         NNZWI  = 1
         NPPI   = 1
         IDFI   = 1
         JOBI   = 1
         IPRINI = 1
         LUNERI = 1
         LUNRPI = 1
         NROWI  = 1
         NTOLI  = 1
         NETAI  = 1
         MAXITI = 1
         NITERI = 1
         NFEVI  = 1
         NJEVI  = 1
         INT2I  = 1
         IRANKI = 1
         LDTTI  = 1
         LIWKMN = 1
      END IF
*
      RETURN
      END
*DJACFD
      SUBROUTINE DJACFD
     +   (N,NP,M,BETA,
     +   X,LDX,DELTA,XPLUSD,LDXPD,FUN,
     +   SS,TT,LDTT,NETA,PV,STP,
     +   IFIXB,FJACB,LDFJB,ISODR,
     +   IFIXX,LDIFX,FJACX,LDFJX,NFEV,ISTOP)
C***BEGIN PROLOGUE  DJACFD
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE FINITE DIFFERENCE APPROXIMATIONS TO THE
C            JACOBIAN WRT THE ESTIMATED BETAS AND WRT THE DELTAS
C***END PROLOGUE  DJACFD
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOP,LDFJB,LDFJX,LDIFX,LDTT,LDX,LDXPD,M,N,NETA,NFEV,NP
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),DELTA(N,M),FJACB(LDFJB,NP),
     +   FJACX(LDFJX,M),PV(N),SS(NP),STP(N),TT(LDTT,M),
     +   X(LDX,M),XPLUSD(LDXPD,M)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   BETAJ,ONE,SQREPS,TEN,TWO,TYPJ,ZERO
      INTEGER
     +   I,J,JFX
      LOGICAL
     +   DOIT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MAX,SIGN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TWO,TEN
     +   /0.0D0,1.0D0,2.0D0,10.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C     DOUBLE PRECISION BETAJ
C        THE J-TH FUNCTION PARAMETER.
C     DOUBLE PRECISION DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOIT
C        THE INDICATOR VARIABLE USED TO SPECIFY WHETHER THE DERIVATIVE
C        WRT A GIVEN BETA OR X NEEDS TO BE COMPUTED (DOIT=TRUE) OR NOT
C        (DOIT=FALSE).
C     DOUBLE PRECISION FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     DOUBLE PRECISION FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JFX
C        AN INDEXING VARIABLE.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF GOOD DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION PV(N)
C        THE PREDICTED VALUES OF THE MODEL FUNCTION AT THE CURRENT
C        POINT.
C     DOUBLE PRECISION SQREPS
C        THE SQUARE ROOT OF MACHINE PRECISION.
C     DOUBLE PRECISION SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION STP(N)
C        THE STEP USED TO COMPUTE FINITE DIFFERENCE DERIVATIVES.
C     DOUBLE PRECISION TEN
C        THE VALUE 10.0D0.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TWO
C        THE VALUE 2.0D0.
C     DOUBLE PRECISION TYPJ
C        THE TYPICAL SIZE OF THE J-TH UNKNOWN BETA OR DELTA.
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DJACFD
*
*
C  SET THE RELATIVE STEP SIZE FOR COMPUTING THE JACOBIANS
*
      SQREPS = TEN**(-NETA/TWO)
*
C  COMPUTE THE PREDICTED VALUES OF THE FUNCTION AT THE GIVEN POINT
*
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PV,ISTOP)
      NFEV = NFEV + 1
      IF (ISTOP.LT.0) THEN
         RETURN
      END IF
*
C  COMPUTE THE JACOBIAN WRT THE ESTIMATED BETAS
*
      JFX = 0
      DO 20 J=1,NP
         IF (IFIXB(1).GE.0) THEN
            IF (IFIXB(J).EQ.0) THEN
               DOIT = .FALSE.
            ELSE
               DOIT = .TRUE.
            END IF
         ELSE
            DOIT = .TRUE.
         END IF
         IF (DOIT) THEN
            JFX = JFX + 1
            BETAJ = BETA(J)
            TYPJ = ONE/SS(JFX)
            STP(J) = BETAJ + SQREPS*SIGN(ONE,BETAJ)*MAX(ABS(BETAJ),TYPJ)
            STP(J) = STP(J) - BETAJ
            BETA(J) = BETAJ + STP(J)
            CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,FJACB(1,JFX),ISTOP)
            NFEV = NFEV + 1
            IF (ISTOP.LT.0) THEN
               RETURN
            END IF
            DO 10 I=1,N
               FJACB(I,JFX) = (FJACB(I,JFX)-PV(I))/STP(J)
   10       CONTINUE
            BETA(J) = BETAJ
         END IF
   20 CONTINUE
*
C  COMPUTE THE JACOBIAN WRT THE X'S
*
      IF (ISODR) THEN
         DO 70 J=1,M
            IF (IFIXX(1,1).LT.0) THEN
               DOIT = .TRUE.
            ELSE IF (LDIFX.EQ.1) THEN
               IF (IFIXX(1,J).EQ.0) THEN
                  DOIT = .FALSE.
               ELSE
                  DOIT = .TRUE.
               END IF
            ELSE
               DO 30 I=1,N
                  IF (IFIXX(I,J).NE.0) THEN
                     DOIT = .TRUE.
                     GO TO 40
                  END IF
   30          CONTINUE
               DOIT = .FALSE.
   40          CONTINUE
            END IF
            IF (.NOT.DOIT) THEN
               CALL DZERO(N,1,FJACX(1,J),N)
            ELSE
               DO 50 I=1,N
                  IF (TT(1,1).GT.ZERO) THEN
                     IF (LDTT.EQ.1) THEN
                        TYPJ = ONE/TT(1,J)
                     ELSE
                        TYPJ = ONE/TT(I,J)
                     END IF
                  ELSE
                     TYPJ = ABS(ONE/TT(1,1))
                  END IF
                  STP(I) = XPLUSD(I,J) + SQREPS*SIGN(ONE,XPLUSD(I,J))*
     +                     MAX(ABS(XPLUSD(I,J)),TYPJ)
                  STP(I) = STP(I) - XPLUSD(I,J)
                  XPLUSD(I,J) = XPLUSD(I,J) + STP(I)
   50          CONTINUE
               CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,FJACX(1,J),ISTOP)
               NFEV = NFEV + 1
               IF (ISTOP.LT.0) THEN
                  RETURN
               END IF
               DO 60 I=1,N
                  FJACX(I,J) = (FJACX(I,J)-PV(I))/STP(I)
                  XPLUSD(I,J) = X(I,J) + DELTA(I,J)
   60          CONTINUE
            END IF
   70    CONTINUE
      END IF
*
      RETURN
      END
*DJCK
      SUBROUTINE DJCK
     +   (FUN,JAC,NFEV,NJEV,
     +   N,NP,M,BETA,XPLUSD,LDXPD,
     +   ETA,NETA,NTOL,SS,TT,LDTT,NROW,ISODR,EPSMAC,
     +   PVTEMP,FJACB,LDFJB,FJACX,LDFJX,
     +   MSGB,MSGX,ISTOPF,ISTOPJ)
C***BEGIN PROLOGUE  DJCK
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DJCKM
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  DRIVER ROUTINE FOR THE DERIVATIVE CHECKING PROCESS
C           (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKCNT)
C***END PROLOGUE  DJCK
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   EPSMAC,ETA
      INTEGER
     +   ISTOPF,ISTOPJ,LDFJB,LDFJX,LDTT,LDXPD,M,N,NETA,NFEV,
     +   NJEV,NP,NROW,NTOL
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),FJACB(LDFJB,NP),
     +   FJACX(LDFJX,M),PVTEMP(N),SS(NP),
     +   TT(LDTT,M),XPLUSD(LDXPD,M)
      INTEGER
     +   MSGB(NP+1),MSGX(M+1)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ONE,PV,TEN,TOL,TYPJ,ZERO
      INTEGER
     +   J
      LOGICAL
     +   ISWRTB
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DJCKM
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,INT,LOG10
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TEN
     +   /0.0D0,1.0D0,10.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION ETA
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     DOUBLE PRECISION FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     DOUBLE PRECISION FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE JACOBIAN GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF RELIABLE DIGITS IN THE MODEL RESULTS, EITHER
C        SET BY THE USER OR COMPUTED BY DETAF.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY
C        AT WHICH THE DERIVATIVE IS CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        EITHER SET BY THE USER OR COMPUTED FROM NETA.
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     DOUBLE PRECISION PVTEMP(N)
C        THE PREDICTED VALUE BASED ON THE CURRENT PARAMETER ESTIMATES
C     DOUBLE PRECISION SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TEN
C        THE VALUE 10.0D0.
C     DOUBLE PRECISION TOL
C        THE AGREEMENT TOLERANCE.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TYPJ
C        THE TYPICAL SIZE OF THE J-TH UNKNOWN BETA OR DELTA.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DJCK
*
*
C  SET TOLERANCE FOR CHECKING DERIVATIVES
*
      IF ((NTOL.LT.1) .OR. (NTOL.GT.(NETA+1)/2)) THEN
         NTOL = (NETA+3)/4
      END IF
*
      TOL = TEN**(-NTOL)
*
C  COMPUTE PREDICTED VALUE OF MODEL USING CURRENT PARAMETER
C  ESTIMATES, AND COMPUTE USER-SUPPLIED DERIVATIVE VALUES
*
      ISTOPF = 0
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,ISTOPF)
      NFEV = NFEV + 1
      IF (ISTOPF.NE.0) THEN
         RETURN
      END IF
      PV = PVTEMP(NROW)
*
      ISTOPJ = 0
      CALL JAC(N,NP,M,BETA,XPLUSD,LDXPD,FJACB,LDFJB,
     +         ISODR,FJACX,LDFJX,ISTOPJ)
      NJEV = NJEV + 1
      IF (ISTOPJ.NE.0) THEN
         RETURN
      END IF
*
C  CHECK DERIVATIVES WRT BETA
*
      ISWRTB = .TRUE.
      MSGB(1) = 0
*
      DO 10 J=1,NP
*
         IF (SS(1).GT.ZERO) THEN
            TYPJ = ONE/SS(J)
         ELSE
            TYPJ = ONE/ABS(SS(1))
         END IF
*
C  CHECK DERIVATIVE WRT THE J-TH PARAMETER AT THE NROW-TH ROW
*
         CALL DJCKM(FUN,NFEV,
     +              N,NP,M,XPLUSD,LDXPD,BETA,TYPJ,
     +              ETA,TOL,EPSMAC,
     +              J,NROW,PV,FJACB(NROW,J),PVTEMP,
     +              ISWRTB,MSGB,NP+1,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
*
   10 CONTINUE
*
C  CHECK DERIVATIVES WRT X
*
      MSGX(1) = 0
*
      IF (ISODR) THEN
         ISWRTB = .FALSE.
         DO 20 J=1,M
*
            IF (TT(1,1).GT.ZERO) THEN
               IF (LDTT.EQ.1) THEN
                  TYPJ = ONE/TT(1,J)
               ELSE
                  TYPJ = ONE/TT(NROW,J)
               END IF
            ELSE
               TYPJ = ABS(ONE/TT(1,1))
            END IF
*
C  CHECK DERIVATIVE WRT THE J-TH COLUMN OF X AT ROW NROW
*
            CALL DJCKM(FUN,NFEV,
     +                 N,NP,M,XPLUSD,LDXPD,BETA,TYPJ,
     +                 ETA,TOL,EPSMAC,
     +                 J,NROW,PV,FJACX(NROW,J),PVTEMP,
     +                 ISWRTB,MSGX,M+1,ISTOPF)
            IF (ISTOPF.NE.0) THEN
               RETURN
            END IF
*
   20    CONTINUE
      END IF
*
C  PRINT RESULTS IF THEY ARE DESIRED
*
      RETURN
*
      END
*DJCKC
      SUBROUTINE DJCKC
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,EPSMAC,
     +   J,NROW,PV,D,FD,PARMX,PVPSTP,STP,
     +   PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  DJCKC
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DJCKF,DPVB,DPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK WHETHER HIGH CURVATURE COULD BE THE CAUSE OF THE
C            DISAGREEMENT BETWEEN THE NUMERICAL AND ANALYTIC DERVIATIVES
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKCRV)
C***END PROLOGUE  DJCKC
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   D,EPSMAC,ETA,FD,PARMX,PV,PVPSTP,STP,TOL
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   CURVE,FIVE,ONE,PVMCRV,PVPCRV,STPCRV,THIRD,THREE,TWO
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DPVB,DPVD
      EXTERNAL
     +   DPVB,DPVD
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DJCKF
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,SIGN
*
C...DATA STATEMENTS
      DATA
     +   ONE,TWO,THREE,FIVE
     +   /1.0D0,2.0D0,3.0D0,5.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION CURVE
C        A MEASURE OF THE CURVATURE IN THE MODEL.
C     DOUBLE PRECISION D
C        THE SCALAR IN WHICH ROW   NROW   OF THE DERIVATIVE
C        MATRIX WITH RESPECT TO THE JTH UNKNOWN PARAMETER
C        IS STORED.
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION ETA
C        THE RELATIVE NOISE IN THE MODEL.
C     DOUBLE PRECISION FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER.
C     DOUBLE PRECISION FIVE
C         THE VALUE 5.0D0.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION ONE
C         THE VALUE 1.0D0.
C     DOUBLE PRECISION PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE.
C     DOUBLE PRECISION PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     DOUBLE PRECISION PVMCRV
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J)-STPCRV.
C     DOUBLE PRECISION PVPCRV
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J)+STPCRV.
C     DOUBLE PRECISION PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     DOUBLE PRECISION PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     DOUBLE PRECISION STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     DOUBLE PRECISION STPCRV
C        THE STEP SIZE SELECTED TO CHECK FOR CURVATURE IN THE MODEL.
C     DOUBLE PRECISION THIRD
C        THE VALUE 1.0D0/3.0D0.
C     DOUBLE PRECISION THREE
C         THE VALUE 3.0D0.
C     DOUBLE PRECISION TOL
C        THE AGREEMENT TOLERANCE.
C     DOUBLE PRECISION TWO
C         THE VALUE 2.0D0.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  DJCKC
*
*
      THIRD = ONE/THREE
*
      IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
         STPCRV = (ETA**THIRD*PARMX*SIGN(ONE,BETA(J))+BETA(J)) - BETA(J)
         PVPCRV = DPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                  NROW,J,STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
         PVMCRV = DPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                  NROW,J,-STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
      ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
         STPCRV = (ETA**THIRD*PARMX*SIGN(ONE,XPLUSD(NROW,J))+
     +             XPLUSD(NROW,J)) - XPLUSD(NROW,J)
         PVPCRV = DPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
         PVMCRV = DPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,-STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
      END IF
*
C  ESTIMATE CURVATURE BY SECOND DERIVATIVE OF MODEL
*
      CURVE = ((PVPCRV-PV)+(PVMCRV-PV)) / (STPCRV*STPCRV)
      CURVE = CURVE + (ETA ** THIRD) * (ABS(PVPCRV) +
     +        ABS(PVMCRV) + TWO * ABS(PV)) / (PARMX * PARMX)
*
C  COMPARE NUMERICAL AND ANALYTICAL DERIVATIVES USING A FUDGE
C  FACTOR OF TEN.
*
      IF (ABS(CURVE*STP)*FIVE.LT.ABS(FD-D)) THEN
*
C  CURVATURE CANNOT ACCOUNT FOR DISCREPANCY.
*
C  CHECK IF FINITE PRECISION ARITHMETIC COULD BE THE CULPRIT.
*
         CALL DJCKF(FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,
     +              J,NROW,PV,D,FD,PARMX,PVPSTP,STP,CURVE,
     +              PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
*
      ELSE
*
C  HIGH CURVATURE COULD BE THE PROBLEM.  TRY A SMALLER STEP SIZE.
*
C  COMPUTE DERIVATIVE WITH SMALLER STEP SIZE
C  IF SMALLER STEP SIZE IS TOO SMALL SET MSG(J+1)=1 ELSE COMPUTE
C  PREDICTED VALUE WITH NEW STEP.
*
         IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
            STP = (TWO*TOL*ABS(D)*SIGN(ONE,BETA(J)) /
     +             ABS(CURVE)+BETA(J)) - BETA(J)
            IF (ABS(STP).LE.EPSMAC*ABS(BETA(J))) THEN
               IF (MSG(1).EQ.0) MSG(1) = 2
               MSG(J+1) = 6
               RETURN
            ELSE
               PVPSTP = DPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                       NROW,J,STP,ISTOPF)
               IF (ISTOPF.NE.0) THEN
                  RETURN
               END IF
            END IF
         ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
            STP = (TWO*TOL*ABS(D)*SIGN(ONE,XPLUSD(NROW,J)) /
     +             ABS(CURVE)+XPLUSD(NROW,J)) - XPLUSD(NROW,J)
            IF (ABS(STP).LE.EPSMAC*ABS(XPLUSD(NROW,J))) THEN
               IF (MSG(1).EQ.0) MSG(1) = 2
               MSG(J+1) = 6
               RETURN
            ELSE
               PVPSTP = DPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                       NROW,J,STP,ISTOPF)
               IF (ISTOPF.NE.0) THEN
                  RETURN
               END IF
            END IF
         END IF
*
C  COMPUTE THE NEW NUMERICAL DERIVATIVE
*
         FD = (PVPSTP-PV)/STP
*
C  CHECK WHETHER THE NEW NUMERICAL DERIVATIVE IS OK
*
         IF (ABS(FD-D).GT.TWO*TOL*ABS(D)) THEN
*
C  NUMERICAL DERIVATIVE COMPUTED USING NEW STEP SIZE DOES
C  NOT AGREE WITH ANALYTIC DERIVATIVE.
*
C  CHECK IF THE PROBLEM COULD BE THE FORWARD DIFFERENCE QUOTIENT
C  DERIVATIVE.
*
C  (FUDGE FACTOR IS 2)
*
            IF (ABS(STP*(FD-D)).GE.TWO*ETA*ABS(PV+PVPSTP)) THEN
*
C  FINITE PRECISION COULD NOT BE THE CULPRIT
*
               MSG(1) = 1
               MSG(J+1) = 1
            ELSE
*
C  FINITE PRECISION MAY BE THE CULPRIT
*
               IF (MSG(1).EQ.0) MSG(1) = 2
               MSG(J+1) = 6
            END IF
         END IF
      END IF
*
      RETURN
      END
*DJCKF
      SUBROUTINE DJCKF
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,
     +   J,NROW,PV,D,FD,PARMX,PVPSTP,STP,CURVE,
     +   PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  DJCKF
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DPVB,DPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK WHETHER FINITE PRECISION ARITHMETIC COULD BE THE
C            CAUSE OF THE DISAGREEMENT BETWEEN THE DERIVATIVES.
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKFPA)
C***END PROLOGUE  DJCKF
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   CURVE,D,ETA,FD,PARMX,PV,PVPSTP,STP,TOL
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ONE,TEN,TWO
      LOGICAL
     +   LARGE
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DPVB,DPVD
      EXTERNAL
     +   DPVB,DPVD
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,SIGN
*
C...DATA STATEMENTS
      DATA
     +   ONE,TWO,TEN
     +   /1.0D0,2.0D0,10.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION CURVE
C        A MEASURE OF THE CURVATURE IN THE MODEL.
C     DOUBLE PRECISION D
C        THE SCALAR IN WHICH ROW   NROW   OF THE DERIVATIVE
C        MATRIX WITH RESPECT TO THE JTH UNKNOWN PARAMETER
C        IS STORED.
C     DOUBLE PRECISION ETA
C        THE RELATIVE NOISE IN THE MODEL
C     DOUBLE PRECISION FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     LOGICAL LARGE
C        AN INDICATOR VALUE INDICATING WHETHER THE RECOMMENDED
C        INCREASE IN THE STEP SIZE WOULD BE GREATER THAN PARMX.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE AND THE
C        TYPICAL VALUE OF THAT PARAMETER
C     DOUBLE PRECISION PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     DOUBLE PRECISION PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     DOUBLE PRECISION PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     DOUBLE PRECISION STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     DOUBLE PRECISION TEN
C        THE VALUE 10.0D0.
C     DOUBLE PRECISION TOL
C        THE AGREEMENT TOLERANCE.
C     DOUBLE PRECISION TWO
C        THE VALUE 2.0D0.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  DJCKF
*
*
C  CHECK WHETHER FINITE PRECISION COULD BE THE PROBLEM
*
      IF (ABS(STP*(FD-D)).GE.TEN*ETA*(ABS(PV)+ABS(PVPSTP))) THEN
*
C  DISCREPANCY BETWEEN NUMERICAL AND ANALYTICAL DERIVATIVES CANNOT
C  BE ACCOUNTED FOR BY FINITE PRECISION ARITHMETIC
*
         MSG(1) = 1
         MSG(J+1) = 1
      ELSE
*
C  FINITE PRECISION ARITHMETIC COULD BE THE PROBLEM.
C  TRY A LARGER STEP SIZE
*
*
         IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
            STP = (ETA*(ABS(PV)+ABS(PVPSTP))*SIGN(ONE,BETA(J))/
     +            (TOL*ABS(D))+BETA(J)) - BETA(J)
            IF (ABS(STP).GT.PARMX) THEN
               STP = PARMX*SIGN(ONE,BETA(J))
               LARGE = .TRUE.
            ELSE
               LARGE = .FALSE.
            END IF
            PVPSTP = DPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                    NROW,J,STP,ISTOPF)
         ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
            STP = (ETA*(ABS(PV)+ABS(PVPSTP))*SIGN(ONE,XPLUSD(NROW,J))/
     +            (TOL*ABS(D))+XPLUSD(NROW,J)) - XPLUSD(NROW,J)
            IF (ABS(STP).GT.PARMX) THEN
               STP = PARMX*SIGN(ONE,XPLUSD(NROW,J))
               LARGE = .TRUE.
            ELSE
               LARGE = .FALSE.
            END IF
            PVPSTP = DPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                    NROW,J,STP,ISTOPF)
         END IF
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
*
         FD = (PVPSTP-PV)/STP
*
C  CHECK FOR AGREEMENT
*
         IF ((ABS(FD-D)).GT.TWO*TOL*ABS(D)) THEN
*
C  FORWARD DIFFERENCE QUOTIENT AND ANALYTIC DERIVATIVES STILL DISAGREE.
C  CHECK IF CURVATURE IS THE PROBLEM
*
            IF (ABS(CURVE*STP).GE.ABS(FD-D) .OR. LARGE) THEN
*
C  CURVATURE MAY BE THE CULPRIT
*
               IF (MSG(1).EQ.0) MSG(1) = 2
               IF (LARGE) THEN
                  MSG(J+1) = 5
               ELSE
                  MSG(J+1) = 6
               END IF
            ELSE
*
C  CURVATURE COULDNT BE THE CULPRIT
*
               MSG(1) = 1
               MSG(J+1) = 1
            END IF
         END IF
      END IF
*
      RETURN
      END
*DJCKM
      SUBROUTINE DJCKM
     +   (FUN,NFEV,
     +   N,NP,M,XPLUSD,LDXPD,BETA,TYPJ,
     +   ETA,TOL,EPSMAC,
     +   J,NROW,PV,D,PVTEMP,
     +   ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  DJCKM
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DJCKC,DJCKZ,DPVB,DPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK USER-SUPPLIED ANALYTIC DERIVATIVES AGAINST NUMERICAL
C            DERIVATIVES
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKMN.)
C***END PROLOGUE  DJCKM
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   D,EPSMAC,ETA,PV,TOL,TYPJ
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   FD,ONE,PARMX,PVPSTP,STP,ZERO
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DPVB,DPVD
      EXTERNAL
     +   DPVB,DPVD
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DJCKC,DJCKZ
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MAX,SIGN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0D0,1.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION D
C        THE SCALAR IN WHICH ROW   NROW   OF THE DERIVATIVE
C        MATRIX WITH RESPECT TO THE JTH UNKNOWN PARAMETER
C        IS STORED.
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION ETA
C        THE RELATIVE NOISE IN THE MODEL
C     DOUBLE PRECISION FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION ONE
C         THE VALUE 1.0D0.
C     DOUBLE PRECISION PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE AND THE
C        TYPICAL VALUE OF THAT PARAMETER
C     DOUBLE PRECISION PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     DOUBLE PRECISION PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     DOUBLE PRECISION PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     DOUBLE PRECISION STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     DOUBLE PRECISION TOL
C        THE AGREEMENT TOLERANCE.
C     DOUBLE PRECISION TYPJ
C        THE TYPICAL SIZE OF THE J-TH UNKNOWN BETA OR DELTA.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C         THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DJCKM
*
*
C  CALCULATE THE JTH PARTIAL DERIVATIVE USING FORWARD DIFFERENCE
C  QUOTIENTS AND DECIDE IF IT AGREES WITH USER SUPPLIED VALUES
*
      MSG(J+1) = 0
*
      IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
         PARMX = MAX(ABS(BETA(J)),ABS(TYPJ))
         STP = (SQRT(ETA)*PARMX*SIGN(ONE,BETA(J))+BETA(J)) - BETA(J)
         PVPSTP = DPVB(FUN,NFEV,
     +                 N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,STP,ISTOPF)
      ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
         PARMX = MAX(ABS(XPLUSD(NROW,J)),ABS(TYPJ))
         STP = (SQRT(ETA)*PARMX*SIGN(ONE,XPLUSD(NROW,J))+XPLUSD(NROW,J))
     +         - XPLUSD(NROW,J)
         PVPSTP = DPVD(FUN,NFEV,
     +                 N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,STP,ISTOPF)
      END IF
      IF (ISTOPF.NE.0) THEN
         RETURN
      END IF
*
      FD = (PVPSTP-PV)/STP
*
C  CHECK FOR DISAGREEMENT
*
      IF (ABS(FD-D).LE.TOL*ABS(D)) THEN
*
C  NUMERICAL AND ANALYTIC DERIVATIVES AGREE
*
C  CHECK IF ANALYTIC DERIVATIVE IS IDENTICALLY ZERO, INDICATING
C  THE POSSIBILITY THAT THE DERIVATIVE SHOULD BE RECHECKED AT
C  ANOTHER POINT.
*
         IF (D.EQ.ZERO) THEN
*
C  JTH ANALYTIC AND NUMERICAL DERIVATIVES BOTH ARE ZERO.
C  SET MSG FLAG ACCORDINGLY.
*
            IF (MSG(1).EQ.0) MSG(1) = 2
            MSG(J+1) = 2
         END IF
*
      ELSE
*
C  NUMERICAL AND ANALYTIC DERIVATIVES DISAGREE
*
C  CHECK WHY
*
         IF (D.EQ.ZERO) THEN
            CALL DJCKZ(FUN,NFEV,
     +                 N,NP,M,XPLUSD,LDXPD,BETA,EPSMAC,
     +                 J,NROW,PV,FD,PARMX,PVPSTP,STP,
     +                 PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
         ELSE
            CALL DJCKC(FUN,NFEV,
     +                 N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,EPSMAC,
     +                 J,NROW,PV,D,FD,PARMX,PVPSTP,STP,
     +                 PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
         END IF
      END IF
*
      RETURN
      END
*DJCKZ
      SUBROUTINE DJCKZ
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,EPSMAC,
     +   J,NROW,PV,FD,PARMX,PVPSTP,STP,
     +   PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  DJCKZ
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DPVB,DPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  RECHECK THE DERIVATIVES IN THE CASE WHERE THE FINITE
C            DIFFERENCE DERIVATIVE DISAGREES WITH THE ANALYTIC
C            DERIVATIVE AND THE ANALYTIC DERIVATIVE IS ZERO.
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKZRO)
C***END PROLOGUE  DJCKZ
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   EPSMAC,FD,PARMX,PV,PVPSTP,STP
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   CD,ONE,PVMSTP,THREE,TWO,ZERO
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DPVB,DPVD
      EXTERNAL
     +   DPVB,DPVD
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TWO,THREE
     +   /0.0D0,1.0D0,2.0D0,3.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION CD
C        THE CENTRAL DIFFERENCE QUOTIENT DERIVATIVE WITH
C        RESPECT TO THE JTH PARAMETER.
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR X (ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE AND THE TYPICAL
C        VALUE OF THAT PARAMETER.
C     DOUBLE PRECISION PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     DOUBLE PRECISION PVMSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) - STP.
C     DOUBLE PRECISION PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     DOUBLE PRECISION PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     DOUBLE PRECISION STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     DOUBLE PRECISION THREE
C        THE VALUE 3.0D0.
C     DOUBLE PRECISION TWO
C        THE VALUE 2.0D0.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DJCKZ
*
*
C  RECALCULATE NUMERICAL DERIVATIVE USING CENTRAL DIFFERENCE AND STEP
C  SIZE OF 2*STP
*
      IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
         PVMSTP = DPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,-STP,ISTOPF)
      ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
         PVMSTP = DPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,-STP,ISTOPF)
      END IF
      IF (ISTOPF.NE.0) THEN
         RETURN
      END IF
*
      CD = (PVPSTP-PVMSTP)/(TWO*STP)
*
C  CHECK FOR DISAGREEMENT
*
      IF (CD.EQ.ZERO) THEN
*
C  NUMERICAL AND ANALYTIC DERIVATIVES NOW AGREE, BUT BOTH EQUAL ZERO,
C  INDICATING THAT DERIVATIVES SHOULD BE RECHECKED AT ANOTHER POINT.
*
         IF (MSG(1).EQ.0) MSG(1) = 2
         MSG(J+1) = 2
      ELSE
*
C  NUMERICAL AND ANALYTIC DERIVATIVE STILL DO NOT AGREE.
C  CHECK IF NUMERICAL DERIVATIVE IS CLOSE TO ZERO.
*
         IF (MIN(ABS(CD),ABS(FD))*PARMX.LE.
     +          ABS(PV*EPSMAC**(ONE/THREE))) THEN
*
C  NUMERICAL DERIVATIVE IS CLOSE TO ZERO
*
            IF (MSG(1).EQ.0) MSG(1) = 2
            MSG(J+1) = 3
         ELSE
*
C  NUMERICAL DERIVATIVE NOT CLOSE TO ZERO
*
            IF (MSG(1).EQ.0) MSG(1) = 2
            MSG(J+1) = 4
         END IF
      END IF
*
      RETURN
      END
*DODCHK
      SUBROUTINE DODCHK
     +   (N,NP,M,
     +   IFIXB,
     +   LDX,LDIFX,LDSCLD,LDWD,
     +   LWORK,LWKMN,LIWORK,LIWKMN,
     +   SCLD,SCLB,W,WD,
     +   INFO)
C***BEGIN PROLOGUE  DODCHK
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK INPUT PARAMETERS, INDICATING ERRORS FOUND USING
C            NONZERO VALUES OF ARGUMENT INFO AS DESCRIBED IN THE
C            PROLOGUES FOR DODR AND DODRC.
C***END PROLOGUE  DODCHK
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,LDIFX,LDSCLD,LDWD,LDX,LIWKMN,LIWORK,LWKMN,LWORK,M,N,
     +   NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   SCLB(NP),SCLD(LDSCLD,M),W(N),WD(LDWD,M)
      INTEGER
     +   IFIXB(NP)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ZERO
      INTEGER
     +   I,J,K,LAST,NNZW,NPP
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   LOG10
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER LAST
C        THE LAST ROW OF THE ARRAY TO BE ACCESSED.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODCHK
*
*
C  FIND ACTUAL NUMBER OF PARAMETERS BEING ESTIMATED
*
      IF (NP.LE.0 .OR. IFIXB(1).LT.0) THEN
         NPP = NP
      ELSE
         NPP = 0
         DO 10 K=1,NP
            IF (IFIXB(K).NE.0) THEN
               NPP = NPP + 1
            END IF
   10    CONTINUE
      END IF
*
C  CHECK PROBLEM SPECIFICATION PARAMETERS
*
      IF (N.LE.0 .OR. M.LE.0 .OR. NPP.LE.0 .OR. NPP.GT.N) THEN
         INFO = 10000
         IF (N.LE.0) THEN
            INFO = INFO + 1000
         END IF
         IF (M.LE.0) THEN
            INFO = INFO + 100
         END IF
         IF (NPP.LE.0 .OR. NPP.GT.N) THEN
            INFO = INFO + 10
         END IF
         RETURN
      END IF
*
C  CHECK DIMENSION SPECIFICATION PARAMETERS
*
      IF (LDX.LT.N .OR.
     +   (LDIFX.NE.1 .AND. LDIFX.LT.N) .OR.
     +   (LDSCLD.NE.1 .AND. LDSCLD.LT.N) .OR.
     +   (LDWD.NE.1 .AND. LDWD.LT.N) .OR.
     +   LWORK.LT.LWKMN .OR. LIWORK.LT.LIWKMN) THEN
         INFO = 20000
         IF (LDX.LT.N) THEN
            INFO = INFO + 1000
         END IF
         IF (LDIFX.NE.1 .AND. LDIFX.LT.N) THEN
            INFO = INFO + 100
         END IF
         IF (LDSCLD.NE.1 .AND. LDSCLD.LT.N) THEN
            INFO = INFO + 200
         END IF
         IF (LDWD.NE.1 .AND. LDWD.LT.N) THEN
            INFO = INFO + 400
         END IF
         IF (LWORK.LT.LWKMN) THEN
            INFO = INFO + 10
         END IF
         IF (LIWORK.LT.LIWKMN) THEN
            INFO = INFO + 1
         END IF
         RETURN
      END IF
*
C  CHECK DELTA SCALING
*
      IF (SCLD(1,1).GT.0) THEN
         DO 30 J=1,M
            IF (LDSCLD.GE.N) THEN
               LAST = N
            ELSE
               LAST = 1
            END IF
            DO 20 I=1,LAST
               IF (SCLD(I,J).LE.0) THEN
                  INFO = 31000
                  GO TO 40
               END IF
   20       CONTINUE
   30    CONTINUE
      END IF
*
C  CHECK BETA SCALING
*
   40 IF (SCLB(1).GT.0) THEN
         DO 50 K=1,NP
            IF (SCLB(K).LE.0) THEN
               IF (INFO.EQ.0) THEN
                  INFO = 30100
               ELSE
                  INFO = INFO + 100
               END IF
               GO TO 60
            END IF
   50    CONTINUE
      END IF
*
C  CHECK OBSERVATIONAL ERROR WEIGHTS IF INDIVIDUALLY SPECIFIED
*
   60 IF (W(1).GE.ZERO) THEN
         NNZW = 0
         DO 70 I=1,N
            IF (W(I).LT.ZERO) THEN
               IF (INFO.EQ.0) THEN
                  INFO = 30010
               ELSE
                  INFO = INFO + 10
               END IF
               GO TO 80
            ELSE IF (W(I).GT.ZERO) THEN
               NNZW = NNZW + 1
            END IF
   70    CONTINUE
         IF (NNZW.LT.NPP) THEN
            IF (INFO.EQ.0) THEN
               INFO = 30020
            ELSE
               INFO = INFO + 20
            END IF
         END IF
      END IF
*
C  CHECK DELTA WEIGHTS IF INDIVIDUALLY SPECIFIED
*
   80 IF (WD(1,1).GE.ZERO) THEN
         DO 100 J=1,M
            IF (LDWD.GE.N) THEN
               LAST = N
            ELSE
               LAST = 1
            END IF
            DO 90 I=1,LAST
               IF (WD(I,J).LE.ZERO) THEN
                  IF (INFO.EQ.0) THEN
                     INFO = 30001
                  ELSE
                     INFO = INFO + 1
                  END IF
                  GO TO 110
               END IF
   90       CONTINUE
  100    CONTINUE
      END IF
*
  110 RETURN
*
      END
*DODDRV
      SUBROUTINE DODDRV
     +   (SHORT,
     +   FUN,JAC,
     +   N,M,NP,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   Y,
     +   BETA,IFIXB,SCLB,
     +   WD,LDWD,W,
     +   JOB,NDIGIT,TAUFAC,
     +   SSTOL,PARTOL,MAXIT,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
C***BEGIN PROLOGUE  DODDRV
C***REFER TO DODR,DODRC
C***ROUTINES CALLED  DCOPY,DDIAGS,DDOT,DETAF,DEVFUN,DFLAGS,
C                    DINIWK,DIWINF,DJCK,DNRM2,DODCHK,DODMN,
C                    DODPER,DPACK,DSETN,DWDS,DWINF
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PERFORM ERROR CHECKING AND INITIALIZATION, AND BEGIN
C            PROCEDURE FOR PERFORMING ORTHOGONAL DISTANCE REGRESSION
C            (ODR) ORDINARY LINEAR OR NONLINEAR LEAST SQUARES (OLS)
C***END PROLOGUE  DODDRV
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   INFO,IPRINT,JOB,LDIFX,LDSCLD,LDWD,LDX,LIWORK,LUNERR,
     +   LUNRPT,LWORK,M,MAXIT,N,NDIGIT,NP
      LOGICAL
     +   SHORT
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),SCLB(NP),SCLD(LDSCLD,M),
     +   W(N),WD(LDWD,M),WORK(LWORK),X(LDX,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),IWORK(LIWORK)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   EPSMAC,ETA,TEN,ZERO
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSMAI,ETAI,FI,FJACBI,FJACXI,FNI,FSI,I,IDFI,INT2I,IPRINI,
     +   IRANKI,ISTOPF,ISTOPJ,JOBI,JPVTI,LDTT,LDTTI,LIWKMN,LUNERI,
     +   LUNRPI,LWKMN,MAXITI,MSGB,MSGX,NETA,NETAI,NFEV,NFEVI,NITERI,
     +   NJEV,NJEVI,NNZWI,NPPI,NROW,NROWI,NTOL,NTOLI,OLMAVI,OMEGAI,
     +   PARTLI,PNORMI,PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,SI,SSFI,SSI,
     +   SSSI,SSTOLI,TAUFCI,TAUI,TFJACI,TI,TTI,UI,WRK1I,WRK2I,WSSI,
     +   WSSDEI,WSSEPI,XPLUSI,YTI
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DDOT,DNRM2
      EXTERNAL
     +   DDOT,DNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DCOPY,DDIAGS,DETAF,DEVFUN,DFLAGS,DINIWK,DIWINF,DJCK,
     +   DODCHK,DODMN,DODPER,DPACK,DSETN,DWDS,DWINF
*
C...DATA STATEMENTS
      DATA
     +   ZERO,TEN
     +   /0.0D0,10.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION ETA
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER FI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER I
C        AN INDEX VARIABLE.
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE JACOBIAN GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROW
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY DJCK.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY DJCK.
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE, I.E. STANDARD DEVIATION SQUARED.
C     DOUBLE PRECISION SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION TEN
C        THE VALUE 10.0D0.
C     INTEGER TFJACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WORK(LWORK)
C        THE DOUBLE PRECISION WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER YTI
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODDRV
*
*
C  SET STARTING LOCATIONS WITHIN INTEGER WORKSPACE
C  (INVALID VALUES OF M AND/OR NP ARE HANDLED REASONABLY BY DIWINF)
*
      CALL DIWINF(M,NP,
     +            MSGB,MSGX,JPVTI,
     +            NNZWI,NPPI,IDFI,
     +            JOBI,IPRINI,LUNERI,LUNRPI,
     +            NROWI,NTOLI,NETAI,
     +            MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +            LIWKMN)
*
C  SET STARTING LOCATIONS WITHIN DOUBLE PRECISION WORK SPACE
C  (INVALID VALUES OF N, M AND/OR NP ARE HANDLED REASONABLY BY DWINF)
*
      CALL DWINF(N,M,NP,
     +           DELTAI,FI,
     +           WSSI,WSSDEI,WSSEPI,RVARI,
     +           PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +           FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +           DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +           ALPHAI,TFJACI,OMEGAI,YTI,UI,QRAUXI,WRK1I,WRK2I,RCONDI,
     +           ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +           LWKMN)
*
C  INITIALIZE NECESSARY VARIABLES
*
      CALL DFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
      INFO = 0
*
      IF (RESTRT) THEN
*
C  RESET MAXIMUM NUMBER OF ITERATIONS
*
         IWORK(JOBI) = (JOB/10000)*10000 + MOD(IWORK(JOBI),10000)
         IWORK(MAXITI) = IWORK(MAXITI) + 10
         WORK(OLMAVI) = WORK(OLMAVI)*IWORK(NITERI)
         CALL DCOPY(N,WORK(SSSI),1,WORK(FI),1)
*
      ELSE
*
C  PERFORM ERROR CHECKING
*
         CALL DODCHK(N,NP,M,
     +               IFIXB,
     +               LDX,LDIFX,LDSCLD,LDWD,
     +               LWORK,LWKMN,LIWORK,LIWKMN,
     +               SCLD,SCLB,W,WD,
     +               INFO)
         IF (INFO.NE.0) THEN
            GO TO 20
         END IF
*
C  INITIALIZE WORK VECTORS AS NECESSARY
*
         CALL DINIWK(N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +               X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +               BETA,SCLB,
     +               SSTOL,PARTOL,MAXIT,TAUFAC,
     +               JOB,IPRINT,LUNERR,LUNRPT,
     +               EPSMAI,SSTOLI,PARTLI,MAXITI,TAUFCI,
     +               JOBI,IPRINI,LUNERI,LUNRPI,
     +               SSFI,TTI,LDTTI,DELTAI)
*
         IWORK(INT2I)  = 0
         IWORK(IRANKI) = 0
         IWORK(NFEVI)  = 0
         IWORK(NITERI) = 0
         IWORK(NJEVI)  = 0
         IWORK(IDFI)   = 0
*
         WORK(ACTRSI)  = ZERO
         WORK(ALPHAI)  = ZERO
         WORK(OLMAVI)  = ZERO
         WORK(PNORMI)  = ZERO
         WORK(PRERSI)  = ZERO
         WORK(RCONDI)  = ZERO
         WORK(WSSI)    = ZERO
         WORK(WSSEPI)  = ZERO
         WORK(WSSDEI)  = ZERO
         WORK(RVARI)   = ZERO
         WORK(RNORSI)  = ZERO
*
         WORK(TAUI)    = -WORK(TAUFCI)
*
C  SET UP FOR PARAMETER ESTIMATION -
C  PULL BETA'S TO BE ESTIMATED AND CORRESPONDING SCALE VALUES
C  AND STORE IN WORK(BETACI) AND WORK(SSI), RESPECTIVELY
*
         CALL DPACK(NP,IWORK(NPPI),WORK(BETACI),BETA,IFIXB)
         IF (WORK(SSFI).GT.ZERO) THEN
            CALL DPACK(NP,IWORK(NPPI),WORK(SSI),WORK(SSFI),IFIXB)
         ELSE
            WORK(SSI) = WORK(SSFI)
         END IF
*
C  EVALUATE THE WEIGHTED EPSILONS AT THE STARTING POINT
*
         CALL DEVFUN(N,NP,M,WORK(BETACI),BETA,IFIXB,FUN,
     +               X,LDX,Y,WORK(DELTAI),N,WORK(XPLUSI),N,
     +               W,WORK(FI),IWORK(NFEVI),ISTOPF)
         IF (ISTOPF.NE.0) THEN
            INFO = 52000
            GO TO 20
         END IF
*
C  FIND NUMBER OF NONZERO WEIGHTS
*
         IF (W(1).LT.ZERO) THEN
            IWORK(NNZWI) = N
         ELSE
            IWORK(NNZWI) = 0
            DO 10 I=1,N
               IF (W(I).GT.ZERO) THEN
                  IWORK(NNZWI) = IWORK(NNZWI) + 1
               END IF
   10       CONTINUE
         END IF
*
C  COMPUTE NORM OF THE INITIAL ESTIMATES
*
         CALL DDIAGS(IWORK(NPPI),1,WORK(SSI),IWORK(NPPI),
     +               WORK(BETACI),IWORK(NPPI),WORK(SSSI),IWORK(NPPI))
         CALL DDIAGS(N,M,WORK(TTI),IWORK(LDTTI),WORK(DELTAI),N,
     +               WORK(SSSI+IWORK(NPPI)),N)
         WORK(PNORMI) = DNRM2(IWORK(NPPI)+N*M,WORK(SSSI),1)
*
C  COMPUTE SUM OF SQUARES OF THE WEIGHTED EPSILONS AND WEIGHTED DELTAS
*
         CALL DCOPY(N,WORK(FI),1,WORK(SSSI),1)
         WORK(WSSEPI) = DDOT(N,WORK(SSSI),1,WORK(SSSI),1)
         CALL DWDS(N,M,W,WD,LDWD,WORK(DELTAI),N,WORK(SSSI+N),N)
         WORK(WSSDEI) = DDOT(N*M,WORK(SSSI+N),1,WORK(SSSI+N),1)
         WORK(WSSI) = WORK(WSSEPI) + WORK(WSSDEI)
*
C  SELECT FIRST ROW OF X + DELTA THAT CONTAINS NO ZEROS
*
         NROW = -1
         CALL DSETN(N,M,WORK(XPLUSI),N,NROW)
         IWORK(NROWI) = NROW
*
C  SET NUMBER OF GOOD DIGITS IN FUNCTION RESULTS
*
         EPSMAC = WORK(EPSMAI)
         IF ((NDIGIT.LT.2) .OR.
     +       (NDIGIT.GT.INT(-LOG10(EPSMAC)))) THEN
            IWORK(NETAI) = -1
            NFEV = IWORK(NFEVI)
            CALL DETAF(FUN,NFEV,
     +                 N,NP,M,WORK(XPLUSI),N,
     +                 BETA,ETA,NETA,EPSMAC,
     +                 NROW,WORK(BETANI),WORK(FNI),ISTOPF)
            IWORK(NFEVI) = NFEV
            IF (ISTOPF.NE.0) THEN
               INFO = 53000
               IWORK(NETAI) = 0
               WORK(ETAI) = ZERO
               GO TO 20
            ELSE
               IWORK(NETAI) = NETA
               WORK(ETAI) = ETA
            END IF
         ELSE
            IWORK(NETAI) = NDIGIT
            WORK(ETAI) = TEN**(-NDIGIT)
         END IF
*
C  CHECK DERIVATIVES IF NECESSARY
*
         IF (CHKJAC .AND. ANAJAC) THEN
            NTOL = -1
            NFEV = IWORK(NFEVI)
            NJEV = IWORK(NJEVI)
            NETA = IWORK(NETAI)
            LDTT = IWORK(LDTTI)
            ETA = WORK(ETAI)
            EPSMAC = WORK(EPSMAI)
            CALL DJCK(FUN,JAC,NFEV,NJEV,
     +                N,NP,M,BETA,WORK(XPLUSI),N,
     +                ETA,NETA,NTOL,
     +                WORK(SSFI),WORK(TTI),LDTT,NROW,
     +                ISODR,EPSMAC,
     +                WORK(FNI),WORK(FJACBI),N,WORK(FJACXI),N,
     +                IWORK(MSGB),IWORK(MSGX),ISTOPF,ISTOPJ)
            IWORK(NFEVI) = NFEV
            IWORK(NJEVI) = NJEV
            IWORK(NTOLI) = NTOL
            IF (ISTOPF.NE.0) THEN
               INFO = 54000
            ELSE IF (ISTOPJ.NE.0) THEN
               INFO = 50200
            ELSE IF (IWORK(MSGB).NE.0 .OR. IWORK(MSGX).NE.0) THEN
               INFO = 40000
            END IF
         ELSE
*
C  INDICATE USER-SUPPLIED DERIVATIVES WERE NOT CHECKED
*
            IWORK(MSGB) = -1
            IWORK(MSGX) = -1
         END IF
      END IF
*
C  PRINT APPROPRIATE ERROR MESSAGES
*
   20 IF (INFO.NE.0) THEN
         IF (LUNERR.NE.0 .AND. IPRINT.NE.0) THEN
            CALL DODPER
     +         (INFO,LUNERR,SHORT,
     +         N,NP,M,
     +         LDSCLD,LDWD,
     +         LWKMN,LIWKMN,
     +         SCLD,SCLB,W,WD,
     +         IWORK(MSGB),ISODR,IWORK(MSGX),
     +         WORK(XPLUSI),N,IWORK(NROWI),IWORK(NETAI),IWORK(NTOLI))
         END IF
*
C  SET INFO TO REFLECT ERRORS IN THE USER-SUPPLIED JACOBIANS
*
         IF (INFO.EQ.40000) THEN
            IF (IWORK(MSGB).EQ.1 .OR. IWORK(MSGX).EQ.1) THEN
               IF (IWORK(MSGB).EQ.1) THEN
                  INFO = INFO + 1000
               END IF
               IF (IWORK(MSGX).EQ.1) THEN
                  INFO = INFO + 100
               END IF
            ELSE
               INFO = 0
            END IF
         END IF
         IF (INFO.NE.0) THEN
            RETURN
         END IF
      END IF
*
C  FIND LEAST SQUARES SOLUTION
*
      LDTT = IWORK(LDTTI)
      CALL DODMN(FUN,JAC,
     +           N,NP,M,
     +           X,LDX,IFIXX,LDIFX,Y,
     +           WORK(BETACI),IFIXB,BETA,WORK(BETANI),WORK(BETASI),
     +           WORK(SI),WORK(DELTAI),WORK(DELTNI),WORK(DELTSI),
     +           WORK(TI),WORK(FI),WORK(FNI),WORK(FSI),
     +           WORK(FJACBI),IWORK(MSGB),WORK(FJACXI),IWORK(MSGX),
     +           W,WD,LDWD,
     +           WORK(SSFI),WORK(SSI),WORK(TTI),LDTT,
     +           WORK(XPLUSI),WORK(DDELTI),WORK(SSSI),
     +           WORK,LWORK,IWORK,LIWORK,INFO)
*
      RETURN
*
      END
*DODLM
      SUBROUTINE DODLM
     +   (N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +   W,WD,LDWD,SS,TT,LDTT,DDELT,
     +   ALPHA2,TAU,EPSMAC,
     +   SSS,WRK1,TFJACB,OMEGA,YT,
     +   U,QRAUX,WRK2,JPVT,
     +   S,T,NLMS,RCOND,IRANK)
C***BEGIN PROLOGUE  DODLM
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DDIAGI,DDOT,DNRM2,DODSTP
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE LEVENBERG-MARQUARDT PARAMETER AND STEPS S AND T
C            USING ANALOG OF THE TRUST-REGION LEVENBERG-MARQUARDT
C            ALGORITHM
C***END PROLOGUE  DODLM
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   ALPHA2,EPSMAC,RCOND,TAU
      INTEGER
     +   IRANK,LDFJB,LDFJX,LDTT,LDWD,M,N,NLMS,NP,NPP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DDELT(N,M),F(N),FJACB(LDFJB,NP),FJACX(LDFJX,M),
     +   OMEGA(N),QRAUX(N),S(NP),SS(NP),
     +   SSS(N+N*M),T(N,M),TFJACB(N,NP),TT(LDTT,M),U(N),
     +   W(N),WD(LDWD,M),WRK1(N,M),WRK2(NP),YT(N)
      INTEGER
     +   JPVT(NP)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ALPHA1,ALPHAN,BOT,P001,P1,PHI1,PHI2,SA,TOP,ZERO
      INTEGER
     +   I,J
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DDOT,DNRM2
      EXTERNAL
     +   DDOT,DNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DDIAGI,DODSTP
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MAX,MIN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P001,P1
     +   /0.0D0,0.001D0,0.1D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION ALPHAN
C        THE NEW LEVENBERG-MARQUARDT PARAMETER.
C     DOUBLE PRECISION ALPHA1
C        THE PREVIOUS LEVENBERG-MARQUARDT PARAMETER.
C     DOUBLE PRECISION ALPHA2
C        THE CURRENT LEVENBERG-MARQUARDT PARAMETER.
C     DOUBLE PRECISION BOT
C        THE LOWER LIMIT FOR SETTING ALPHA.
C     DOUBLE PRECISION DDELT(N,M)
C        THE ARRAY (W*D)**2 * DELTA.
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     DOUBLE PRECISION FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     DOUBLE PRECISION FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JPVT(NP)
C        THE PIVOT VECTOR.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NLMS
C        THE NUMBER OF LEVENBERG-MARQUARDT STEPS TAKEN.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION OMEGA(N)
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     DOUBLE PRECISION P001
C        THE VALUE 0.001D0
C     DOUBLE PRECISION P1
C        THE VALUE 0.1D0
C     DOUBLE PRECISION PHI1
C        THE PREVIOUS DIFFERENCE BETWEEN THE NORM OF THE SCALED STEP
C        AND THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION PHI2
C        THE CURRENT DIFFERENCE BETWEEN THE NORM OF THE SCALED STEP
C        AND THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION QRAUX(N)
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     DOUBLE PRECISION RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     DOUBLE PRECISION S(NP)
C        THE STEP FOR THE ESTIMATED BETA'S.
C     DOUBLE PRECISION SA
C        THE SCALAR PHI2*(ALPHA1-ALPHA2)/(PHI1-PHI2).
C     DOUBLE PRECISION SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SSS(N+N*M)
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     DOUBLE PRECISION T(N,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     DOUBLE PRECISION TAU
C        THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION TFJACB(N,NP)
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     DOUBLE PRECISION TOP
C        THE UPPER LIMIT FOR SETTING ALPHA.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION U(N)
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WRK1(N,M)
C        A WORK ARRAY.
C     DOUBLE PRECISION WRK2(NP)
C        A WORK ARRAY.
C     DOUBLE PRECISION YT(N)
C         THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODLM
*
*
C  COMPUTE FULL GAUSS-NEWTON STEP (ALPHA=0)
*
      ALPHA1 = ZERO
      CALL DODSTP(N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +            W,WD,LDWD,SS,TT,LDTT,DDELT,
     +            ALPHA1,EPSMAC,
     +            SSS,TFJACB,WRK1,OMEGA,
     +            YT,U,QRAUX,WRK2,
     +            JPVT,S,T,PHI1,IRANK,
     +            RCOND)
*
C  INITIALIZE TAU IF NECESSARY
*
      IF (TAU.LT.ZERO) THEN
         TAU = ABS(TAU)*PHI1
      END IF
*
C  CHECK IF FULL GAUSS-NEWTON STEP IS OPTIMAL
*
      IF ((PHI1-TAU).LE.P1*TAU) THEN
         NLMS = 1
         ALPHA2 = ZERO
         RETURN
      END IF
*
C  FULL GAUSS-NEWTON STEP IS OUTSIDE TRUST REGION -
C  FIND LOCALLY CONSTRAINED OPTIMAL STEP
*
      PHI1 = PHI1 - TAU
*
C  INITIALIZE UPPER AND LOWER BOUNDS FOR ALPHA
*
      BOT = ZERO
*
      IF (NPP.GE.1) THEN
         DO 10 I=1,NPP
            SSS(I) = DDOT(N,FJACB(1,I),1,F,1)
   10    CONTINUE
         CALL DDIAGI(NPP,1,SS,NPP,SSS,NPP,SSS,NPP)
      END IF
      DO 30 J=1,M
         DO 20 I=1,N
            WRK1(I,J) = FJACX(I,J)*F(I) + DDELT(I,J)
   20    CONTINUE
   30 CONTINUE
      CALL DDIAGI(N,M,TT,LDTT,WRK1,N,SSS(1+NPP),N)
      TOP = DNRM2(NPP+N*M,SSS,1)/TAU
      IF (ALPHA2.GT.TOP .OR. ALPHA2.EQ.ZERO) THEN
         ALPHA2 = P001*TOP
      END IF
*
C  MAIN LOOP
*
      DO 40 I=1,10
*
C  COMPUTE LOCALLY CONSTRAINED STEPS S AND T AND PHI(ALPHA) FOR
C  CURRENT VALUE OF ALPHA
*
         CALL DODSTP(N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +               W,WD,LDWD,SS,TT,LDTT,DDELT,
     +               ALPHA2,EPSMAC,
     +               SSS,TFJACB,WRK1,OMEGA,
     +               YT,U,QRAUX,WRK2,
     +               JPVT,S,T,PHI2,IRANK,
     +               RCOND)
         PHI2 = PHI2-TAU
*
C  CHECK WHETHER CURRENT STEP IS OPTIMAL
*
         IF (ABS(PHI2).LE.P1*TAU .OR.
     +      (ALPHA2.EQ.BOT .AND. PHI2.LT.ZERO)) THEN
            NLMS = I+1
            RETURN
         END IF
*
C  CURRENT STEP IS NOT OPTIMAL
*
C  UPDATE BOUNDS FOR ALPHA AND COMPUTE NEW ALPHA
*
         IF (PHI1-PHI2.EQ.ZERO) THEN
            NLMS = 12
            RETURN
         END IF
         SA = PHI2*(ALPHA1-ALPHA2)/(PHI1-PHI2)
         IF (PHI2.LT.ZERO) THEN
            TOP = MIN(TOP,ALPHA2)
         ELSE
            BOT = MAX(BOT,ALPHA2)
         END IF
         IF (PHI1*PHI2.GT.ZERO) THEN
            BOT = MAX(BOT,ALPHA2-SA)
         ELSE
            TOP = MIN(TOP,ALPHA2-SA)
         END IF
*
         ALPHAN = ALPHA2 - SA*(PHI1+TAU)/TAU
         IF (ALPHAN.GE.TOP .OR. ALPHAN.LE.BOT) THEN
            ALPHAN = MAX(P001*TOP,SQRT(TOP*BOT))
         END IF
*
C  GET READY FOR NEXT ITERATION
*
         ALPHA1 = ALPHA2
         ALPHA2 = ALPHAN
         PHI1 = PHI2
   40 CONTINUE
*
C  SET NLMS TO INDICATE AN OPTIMAL STEP COULD NOT BE FOUND IN 10 TRYS
*
      NLMS = 12
*
      RETURN
      END
*DODMN
      SUBROUTINE DODMN
     +   (FUN,JAC,
     +   N,NP,M,
     +   X,LDX,IFIXX,LDIFX,Y,
     +   BETAC,IFIXB,BETA,BETAN,BETAS,S,
     +   DELTA,DELTAN,DELTAS,T,
     +   F,FN,FS,
     +   FJACB,MSGB,FJACX,MSGX,
     +   W,WD,LDWD,SSF,SS,TT,LDTT,
     +   XPLUSD,DDELT,SSS,
     +   WORK,LWORK,IWORK,LIWORK,INFO)
C***BEGIN PROLOGUE  DODMN
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DACCES,DCOPY,DDIAGS,DDIAGW,DDOT,DEVFUN,DEVJAC,
C                    DFLAGS,DIDTS,DNRM2,DODLM,DODPCR,DQRDC,DPODI,
C                    DSCAL,DUNPAC,DWDS,DXPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  ITERATIVELY COMPUTE LEAST SQUARES SOLUTION
C***END PROLOGUE  DODMN
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,LDIFX,LDTT,LDWD,LDX,LIWORK,LWORK,M,
     +   N,NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),BETAC(NP),BETAN(NP),BETAS(NP),
     +   DDELT(N,M),DELTA(N,M),DELTAN(N,M),DELTAS(N,M),
     +   F(N),FJACB(N,NP),FJACX(N,M),FN(N),FS(N),
     +   S(NP),SS(NP),SSF(NP),SSS(N+N*M),
     +   T(N,M),TT(LDTT,M),W(N),WD(LDWD,M),WORK(LWORK),
     +   X(LDX,M),XPLUSD(N,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),IWORK(LIWORK),MSGB(NP+1),MSGX(M+1)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ACTRED,ACTRS,ALPHA,DIRDER,EPSMAC,OLMAVG,ONE,
     +   P0001,P1,P25,P5,P75,PARTOL,PNORM,PRERED,PRERS,
     +   RATIO,RCOND,RNORM,RNORMN,RNORMS,RVAR,SSTOL,TAU,TAUFAC,
     +   TEMP,TEMP1,TEMP2,TSNORM,WSS,WSSDEL,WSSEPS,ZERO
      INTEGER
     +   I,IDF,IFLAG,INT2,IPR1,IPR2,IPR2F,IPR3,IRANK,ISTOPF,ISTOPJ,J,
     +   JOB,JPVT,JUNFIX,LUNRPT,MAXIT,NETA,NFEV,NITER,NJEV,NLMS,NNZW,
     +   NPP,OMEGA,QRAUX,TFJACB,U,WRK1,WRK2,YT
      LOGICAL
     +   ACCESS,ANAJAC,CHKJAC,CNVPAR,CNVSS,DIDVCV,DOVCV,FSTITR,HEAD,
     +   INITD,INTDBL,ISODR,LSTEP,RESTRT
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   W2(1)
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DDOT,DNRM2
      EXTERNAL
     +   DDOT,DNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DACCES,DCOPY,DDIAGS,DDIAGW,DEVFUN,DEVJAC,DFLAGS,DIDTS,
     +   DODLM,DODPCR,DQRDC,DPODI,DSCAL,DUNPAC,DWDS,DXPY
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MIN,MOD,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P0001,P1,P25,P5,P75,ONE,W2(1)
     +   /0.0D0,0.00010D0,0.10D0,0.250D0,
     +   0.50D0,0.750D0,1.0D0,-1.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ACCESS
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER INFORMATION
C        IS TO BE ACCESSED FROM THE WORK ARRAYS (ACCESS=TRUE) OR
C        STORED IN THEM (ACCESS=FALSE).
C     DOUBLE PRECISION ACTRED
C        THE ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES OF THE
C        WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION ACTRS
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION BETAC(NP)
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     DOUBLE PRECISION BETAN(NP)
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     DOUBLE PRECISION BETAS(NP)
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     LOGICAL CNVPAR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER PARAMETER
C        CONVERGENCE HAS BEEN ATTAINED (CNVPAR=.TRUE.) OR NOT
C        (CNVPAR=.FALSE.).
C     LOGICAL CNVSS
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER SUM-OF-SQUARES
C        CONVERGENCE HAS BEEN ATTAINED (CNVSS=.TRUE.) OR NOT
C        (CNVSS=.FALSE.).
C     DOUBLE PRECISION DDELT(N,M)
C        THE ARRAY (W*D)**2 * DELTA.
C     DOUBLE PRECISION DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     DOUBLE PRECISION DELTAN(N,M)
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     DOUBLE PRECISION DELTAS(N,M)
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DIDVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX WAS COMPUTED (DIDVCV=.TRUE.)
C        OR NOT (DIDVCV=.FALSE.).
C     DOUBLE PRECISION DIRDER
C        THE DIRECTIONAL DERIVATIVE.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX SHOULD TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     DOUBLE PRECISION FJACB(N,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     DOUBLE PRECISION FJACX(N,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     DOUBLE PRECISION FN(N)
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     DOUBLE PRECISION FS(N)
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     LOGICAL FSTITR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THIS IS THE
C        FIRST ITERATION (FSTITR=.TRUE.) OR NOT (FSTITR=.FALSE.).
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFLAG
C        AN INDICATOR VARIABLE, USED TO SPECIFY WHICH COMPUTATION REPORT
C        IS TO BE PRINTED.
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER INT2
C        THE NUMBER OF INTERNAL DOUBLING STEPS TAKEN.
C     LOGICAL INTDBL
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER INTERNAL
C        DOUBLING IS TO BE USED (INTDBL=.TRUE.) OR NOT (INTDBL=.FALSE.).
C     INTEGER IPR1
C        THE VALUE OF THE FOURTH DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE INITIAL SUMMARY REPORT.
C     INTEGER IPR2
C        THE VALUE OF THE THIRD DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE ITERATION REPORTS.
C     INTEGER IPR2F
C        THE VALUE OF THE SECOND DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FREQUENCY OF THE ITERATION REPORTS.
C     INTEGER IPR3
C        THE VALUE OF THE FIRST DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FINAL SUMMARY REPORT.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE JACOBIAN GIVEN THE CURRENT ESTIMATES
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JPVT
C        THE STARTING LOCATION IN IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER JUNFIX
C        THE INDEX OF THE NEXT UNFIXED PARAMETER.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL LSTEP
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER A SUCCESSFUL
C        STEP HAS BEEN FOUND (LSTEP=.TRUE.) OR NOT (LSTEP=.FALSE.).
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NLMS
C        THE NUMBER OF LEVENBERG-MARQUARDT STEPS TAKEN.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION OLMAVG
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGA
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION P0001
C        THE VALUE 0.0001D0.
C     DOUBLE PRECISION P1
C        THE VALUE 0.1D0.
C     DOUBLE PRECISION P25
C        THE VALUE 0.25D0.
C     DOUBLE PRECISION P5
C        THE VALUE 0.5D0.
C     DOUBLE PRECISION P75
C        THE VALUE 0.75D0.
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     DOUBLE PRECISION PRERED
C        THE PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION PRERS
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUX
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     DOUBLE PRECISION RATIO
C        THE RATIO OF THE ACTUAL RELATIVE REDUCTION TO THE PREDICTED
C        RELATIVE REDUCTION IN THE SUM-OF-SQUARES.
C     DOUBLE PRECISION RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     DOUBLE PRECISION RNORM
C        THE NORM OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION RNORMN
C        THE NORM OF THE NEW WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION RNORMS
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION RVAR
C        THE RESIDUAL VARIANCE.
C     DOUBLE PRECISION S(NP)
C        THE STEP FOR THE ESTIMATED BETA'S.
C     DOUBLE PRECISION SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SSS(N+N*M)
C        THE WORK ARRAY USED PRIMARILY FOR COMPUTING VARIOUS
C        SUMS-OF-SQUARES.
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION T(N,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     DOUBLE PRECISION TAU
C        THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TEMP
C        A TEMPORARY STORAGE LOCATION.
C     DOUBLE PRECISION TEMP1
C        A TEMPORARY STORAGE LOCATION.
C     DOUBLE PRECISION TEMP2
C        A TEMPORARY STORAGE LOCATION.
C     INTEGER TFJACB
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB,
C        ALSO USED TO RETURN THE VARIANCE COVARIANCE MATRIX OF THE
C        ESTIMATORS OF THE PARAMETERS.
C     DOUBLE PRECISION TSNORM
C        THE NORM OF THE SCALED STEP.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER U
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WORK(LWORK)
C        THE DOUBLE PRECISION WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     DOUBLE PRECISION WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     DOUBLE PRECISION WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     DOUBLE PRECISION W2(1)
C        THE VALUE USED TO INDICATE THAT THE DEFAULT VALUE
C        OF THE OBSERVATIONAL ERROR WEIGHTS IS TO BE USED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY,
C        ALSO USED TO RETURN THE STANDARD ERRORS FOR THE PARAMETERS.
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION XPLUSD(N,M)
C        THE ARRAY X + DELTA.
C     DOUBLE PRECISION Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER YT
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODMN
*
*
C  INITIALIZE NECESSARY VARIABLES
*
      ACCESS = .TRUE.
      CALL DACCES(N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +            ACCESS,
     +            JPVT,WRK1,TFJACB,OMEGA,YT,U,QRAUX,WRK2,
     +            NNZW,NPP,
     +            JOB,PARTOL,SSTOL,MAXIT,TAUFAC,EPSMAC,NETA,
     +            LUNRPT,IPR1,IPR2,IPR2F,IPR3,
     +            WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +            TAU,ALPHA,NITER,NFEV,NJEV,INT2,OLMAVG,
     +            RCOND,IRANK,ACTRS,PNORM,PRERS,RNORMS)
      RNORM = SQRT(WSS)
      CALL DFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
*
      DIDVCV = .FALSE.
      INTDBL = .FALSE.
      LSTEP = .TRUE.
      HEAD = .TRUE.
*
      FSTITR = .TRUE.
*
C  PRINT INITIAL SUMMARY IF DESIRED
*
      IF (IPR1.NE.0 .AND. LUNRPT.NE.0) THEN
         IFLAG = 1
         CALL DODPCR(HEAD,IFLAG,IPR1,FSTITR,DIDVCV,LUNRPT,
     +               MSGB,MSGX,
     +               N,M,NP,NPP,NNZW,
     +               X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +               BETA,IFIXB,SSF,WORK(WRK2),
     +               JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +               WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +               NITER,NFEV,NJEV,ACTRED,PRERED,
     +               TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
      END IF
*
C  STOP IF INITIAL ESTIMATES ARE EXACT SOLUTION
*
      IF (RNORM .EQ. ZERO) THEN
         INFO = 1
         OLMAVG = ZERO
         GO TO 40
      END IF
*
C  MAIN LOOP
*
   10 CONTINUE
*
      NITER = NITER + 1
      RNORMS = RNORM
*
C  EVALUATE JACOBIAN
*
      CALL DEVJAC(FUN,JAC,ANAJAC,N,NP,NPP,M,BETAC,BETA,
     +            IFIXB,IFIXX,LDIFX,
     +            X,LDX,DELTA,N,XPLUSD,N,
     +            SS,TT,LDTT,NETA,FN,SSS,
     +            FJACB,N,ISODR,FJACX,N,W,NJEV,NFEV,ISTOPJ)
      IF (ISTOPJ.NE.0) THEN
         INFO = 50100
         GO TO 200
      END IF
*
C  COMPUTE DDELT = (W*D)**2 * DELTA
*
      CALL DWDS(N,M,W,WD,LDWD,DELTA,N,DDELT,N)
      CALL DWDS(N,M,W,WD,LDWD,DDELT,N,DDELT,N)
*
C  SUB LOOP FOR
C     INTERNAL DOUBLING OR
C     COMPUTING NEW STEP WHEN OLD FAILED
*
   20 CONTINUE
*
C  COMPUTE STEPS S AND T
*
      CALL DODLM(N,NP,NPP,M,
     +           F,FJACB,N,FJACX,N,
     +           W,WD,LDWD,SS,TT,LDTT,DDELT,
     +           ALPHA,TAU,EPSMAC,
     +           SSS,WORK(WRK1),WORK(TFJACB),WORK(OMEGA),WORK(YT),
     +           WORK(U),WORK(QRAUX),WORK(WRK2),IWORK(JPVT),
     +           S,T,NLMS,RCOND,IRANK)
      OLMAVG = OLMAVG+NLMS
*
C  COMPUTE BETAN = BETAC + S
C          DELTAN = DELTA + T
*
      CALL DXPY(NPP,1,BETAC,NPP,S,NPP,BETAN,NPP)
      CALL DXPY(N,M,DELTA,N,T,N,DELTAN,N)
*
C  COMPUTE NORM OF SCALED STEPS S AND T (TSNORM)
*
      IF (NPP.GE.1) THEN
         CALL DDIAGS(NPP,1,SS,NPP,S,NPP,SSS,NPP)
      END IF
      CALL DDIAGS(N,M,TT,LDTT,T,N,SSS(NPP+1),N)
      TSNORM = DNRM2(NPP+N*M,SSS,1)
*
C  COMPUTE SCALED PREDICTED REDUCTION
*
      DO 30 I=1,N
        SSS(I) = DDOT(NPP,FJACB(I,1),N,S,1) +
     +           DDOT(M,FJACX(I,1),N,T(I,1),N)
   30 CONTINUE
      CALL DWDS(N,M,W,WD,LDWD,T,N,SSS(N+1),N)
      TEMP1 = DNRM2(N+N*M,SSS,1)/RNORM
      TEMP2 = SQRT(ALPHA)*TSNORM/RNORM
      PRERED = TEMP1**2+TEMP2**2/P5
*
      DIRDER = -(TEMP1**2+TEMP2**2)
*
C  EVALUATE WEIGHTED EPSILONS AT NEW POINT
*
      CALL DEVFUN(N,NP,M,BETAN,BETA,IFIXB,FUN,
     +            X,LDX,Y,DELTAN,N,XPLUSD,N,
     +            W,FN,NFEV,ISTOPF)
      IF (ISTOPF.LT.0) THEN
*
C  SET INFO TO INDICATE USER HAS STOPPED THE COMPUTATIONS IN FUN
*
         INFO = 51000
         GO TO 200
      ELSE IF (ISTOPF.GT.0) THEN
*
C  SET NORM TO INDICATE STEP SHOULD BE REJECTED
*
         RNORMN = RNORM/(P1*P75)
      ELSE
*
C  COMPUTE NORM OF NEW WEIGHTED EPSILONS AND WEIGHTED DELTAS (RNORMN)
*
         CALL DCOPY(N,FN,1,SSS,1)
         CALL DWDS(N,M,W,WD,LDWD,DELTAN,N,SSS(N+1),N)
         RNORMN = DNRM2(N+N*M,SSS,1)
      END IF
*
C  COMPUTE SCALED ACTUAL REDUCTION
*
      IF (P1*RNORMN.LT.RNORM) THEN
         ACTRED = ONE - (RNORMN/RNORM)**2
      ELSE
         ACTRED = -ONE
      END IF
*
C  COMPUTE RATIO OF ACTUAL REDUCTION TO PREDICTED REDUCTION
*
      IF(PRERED .EQ. ZERO) THEN
         RATIO = ZERO
      ELSE
         RATIO = ACTRED/PRERED
      END IF
*
C  CHECK ON LACK OF REDUCTION IN INTERNAL DOUBLING CASE
*
      IF (INTDBL .AND. (RATIO.LT.P0001 .OR. RNORMN.GT.RNORMS)) THEN
         TAU = TAU*P5
         ALPHA = ALPHA/P5
         CALL DCOPY(NPP,BETAS,1,BETAN,1)
         CALL DCOPY(N*M,DELTAS,1,DELTAN,1)
         CALL DCOPY(N,FS,1,FN,1)
         ACTRED = ACTRS
         PRERED = PRERS
         RNORMN = RNORMS
         RATIO = P5
      END IF
*
C  UPDATE STEP BOUND
*
      INTDBL = .FALSE.
      IF (RATIO.LT.P25) THEN
         IF (ACTRED.GE.ZERO) THEN
            TEMP = P5
         ELSE
            TEMP = P5*DIRDER/(DIRDER+P5*ACTRED)
         END IF
         IF (P1*RNORMN.GE.RNORM .OR. TEMP.LT.P1) THEN
            TEMP = P1
         END IF
         TAU = TEMP*MIN(TAU,TSNORM/P1)
         ALPHA = ALPHA/TEMP
*
      ELSE IF (ALPHA.EQ.ZERO) THEN
         TAU = TSNORM/P5
*
      ELSE IF (RATIO.GE.P75 .AND. NLMS.LE.11) THEN
*
C  STEP QUALIFIES FOR INTERNAL DOUBLING
C     - UPDATE TAU AND ALPHA
C     - SAVE INFORMATION FOR CURRENT POINT
*
         INTDBL = .TRUE.
*
         TAU = TSNORM/P5
         ALPHA = ALPHA*P5
*
         CALL DCOPY(NPP,BETAN,1,BETAS,1)
         CALL DCOPY(N*M,DELTAN,1,DELTAS,1)
         CALL DCOPY(N,FN,1,FS,1)
         ACTRS = ACTRED
         PRERS = PRERED
         RNORMS = RNORMN
      END IF
*
C  IF INTERNAL DOUBLING, SKIP CONVERGENCE CHECKS
*
      IF (INTDBL .AND. TAU.GT.ZERO) THEN
         INT2 = INT2+1
         GO TO 20
      END IF
*
C  CHECK ACCEPTANCE
*
      IF (RATIO.GE.P0001) THEN
         CALL DCOPY(N,FN,1,F,1)
         CALL DCOPY(NPP,BETAN,1,BETAC,1)
         CALL DCOPY(N*M,DELTAN,1,DELTA,1)
         RNORM = RNORMN
         IF (NPP.GE.1) THEN
            CALL DDIAGS(NPP,1,SS,NPP,BETAC,NPP,SSS,NPP)
         END IF
         CALL DDIAGS(N,M,TT,LDTT,DELTA,N,SSS(NPP+1),N)
         PNORM = DNRM2(NPP+N*M,SSS,1)
         LSTEP = .TRUE.
      ELSE
         LSTEP = .FALSE.
      END IF
*
C  TEST CONVERGENCE
*
      INFO = 0
      CNVSS = RNORM.EQ.ZERO
     +        .OR.
     +        (ABS(ACTRED).LE.SSTOL .AND.
     +         PRERED.LE.SSTOL      .AND.
     +         P5*RATIO.LE.ONE)
      CNVPAR = TAU.LE.PARTOL*PNORM
      IF (CNVSS)                            INFO = 1
      IF (CNVPAR)                           INFO = 2
      IF (CNVSS .AND. CNVPAR)               INFO = 3
*
C  PRINT ITERATION REPORT
*
      IF (INFO.NE.0 .OR. LSTEP) THEN
         IF (IPR2.NE.0 .AND. LUNRPT.NE.0) THEN
            IF (IPR2F.EQ.1 .OR. MOD(NITER,IPR2F).EQ.1) THEN
               IFLAG = 2
               CALL DUNPAC(NP,BETAC,BETA,IFIXB)
               WSS = RNORM*RNORM
               CALL DODPCR(HEAD,IFLAG,IPR2,FSTITR,DIDVCV,LUNRPT,
     +                     MSGB,MSGX,
     +                     N,M,NP,NPP,NNZW,
     +                     X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +                     BETA,IFIXB,SSF,WORK(WRK2),
     +                     JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +                     WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +                     NITER,NFEV,NJEV,ACTRED,PRERED,
     +                     TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
               FSTITR = .FALSE.
            END IF
         END IF
      END IF
*
C  CHECK IF FINISHED
*
      IF (INFO.EQ.0) THEN
         IF (LSTEP) THEN
*
C  BEGIN NEXT INTERATION UNLESS A STOPPING CRITERIA HAS BEEN MET
*
            IF (NITER.GE.MAXIT) THEN
               INFO = 4
            ELSE
               GO TO 10
            END IF
         ELSE
*
C  STEP FAILED - RECOMPUTE UNLESS A STOPPING CRITERIA HAS BEEN MET
*
            GO TO 20
         END IF
      END IF
*
   40 CONTINUE
*
      IF (ISTOPF.GT.0) INFO = INFO + 100
*
C  COMPUTE UNWEIGHTED EPSILONS AND X+DELTA TO RETURN TO USER
*
      CALL DEVFUN(N,NP,M,BETAC,BETA,IFIXB,FUN,
     +            X,LDX,Y,DELTA,N,XPLUSD,N,
     +            W2,F,NFEV,ISTOPF)
      IF (ISTOPF.LT.0) THEN
         INFO = 51000
         GO TO 200
      END IF
*
C  COMPUTE VARIANCE COVARIANCE MATRIX OF ESTIMATED PARAMETERS
C  IN UPPER TRIANGULAR PORTION OF WORK(TFJACB) IF REQUESTED
*
      IF (DOVCV .AND. IRANK.EQ.0 .AND. ISTOPF.EQ.0) THEN
*
C  EVALUATE JACOBIANS AT FINAL SOLUTION
*
         CALL DEVJAC(FUN,JAC,ANAJAC,N,NP,NPP,M,BETAC,BETA,
     +               IFIXB,IFIXX,LDIFX,
     +               X,LDX,DELTA,N,XPLUSD,N,
     +               SSF,TT,LDTT,NETA,FN,SSS,
     +               FJACB,N,ISODR,FJACX,N,W,NJEV,NFEV,ISTOPJ)
         IF (ISTOPJ.NE.0) THEN
            INFO = 50100
            GO TO 200
         END IF
         IDF = 0
         DO 70 I=1,N
            DO 50 J=1,NPP
               IF (FJACB(I,J).NE.ZERO) THEN
                  IDF = IDF + 1
                  GO TO 70
               END IF
   50       CONTINUE
            DO 60 J=1,M
               IF (FJACX(I,J).NE.ZERO) THEN
                  IDF = IDF + 1
                  GO TO 70
               END IF
   60       CONTINUE
   70    CONTINUE
*
         IF (ISODR) THEN
*
C  PROBLEM IS ODR --
C  SET UP OMEGA AND TFJACB
C  (VDTD = FJACX * INV(DT) WHERE DT = (W*D)**2)
*
            CALL DIDTS(N,M,
     +                 W,WD,LDWD,ZERO,TT,LDTT,FJACX,N,WORK(WRK1),N)
            DO 90 I=1,N
               WORK(OMEGA-1+I) =
     +            SQRT(ONE+DDOT(M,WORK(WRK1+I-1),N,FJACX(I,1),N))
               DO 80 J=1,NPP
                  WORK(TFJACB-1+I+(J-1)*N) = FJACB(I,J)/WORK(OMEGA-1+I)
   80          CONTINUE
   90       CONTINUE
*
         ELSE
*
C  PROBLEM IS OLS --
*
            CALL DCOPY(N*NPP,FJACB,1,WORK(TFJACB),1)
*
         END IF
*
         CALL DQRDC
     +      (WORK(TFJACB),N,N,NPP,WORK(QRAUX),IWORK(JPVT),WORK(WRK2),0)
         CALL DPODI
     +      (WORK(TFJACB),N,NPP,WORK(WRK2),1)
*
         IF (IDF.GT.NPP) THEN
            IDF = IDF - NPP
            RVAR = RNORM*RNORM/IDF
         ELSE
            IDF = 0
            RVAR = RNORM*RNORM
         END IF
*
         CALL DSCAL
     +      (N*NPP,RVAR,WORK(TFJACB),1)
         CALL DCOPY
     +      (NPP,WORK(TFJACB),N+1,WORK(WRK2),1)
         IF (NP.GT.NPP) THEN
            JUNFIX = NPP-1
            DO 100 J=NP-1,0,-1
               IF (IFIXB(J+1).EQ.0) THEN
                  WORK(WRK2+J) = ZERO
               ELSE
                  WORK(WRK2+J) = SQRT(WORK(WRK2+JUNFIX))
                  JUNFIX = JUNFIX - 1
               END IF
  100       CONTINUE
         ELSE
            DO 110 J=0,NP-1
               WORK(WRK2+J) = SQRT(WORK(WRK2+J))
  110       CONTINUE
         END IF
*
         DIDVCV = .TRUE.
*
      END IF
*
C  STORE VARIOUS SCALARS IN WORK ARRAYS FOR RETURN TO USER
*
  200 OLMAVG = OLMAVG/NITER
*
C  COMPUTE WEIGHTED EPSILONS AND WEIGHTED DELTAS FOR RETURN TO USER
*
      CALL DDIAGW(N,1,W,F,N,SSS,N)
      WSSEPS = DDOT(N,SSS,1,SSS,1)
      CALL DWDS(N,M,W,WD,LDWD,DELTA,N,SSS(N+1),N)
      WSSDEL = DDOT(N*M,SSS(N+1),1,SSS(N+1),1)
      WSS = WSSEPS + WSSDEL
*
C  COMPUTE ESTIMATED RESPONSE VARIABLE RETURN TO USER, I.E.,
C     EST<Y> = OBS<Y> + EST<EPSILON>
*
      CALL DXPY(N,1,Y,N,F,N,FN,N)
*
      ACCESS = .FALSE.
      CALL DACCES(N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +            ACCESS,
     +            JPVT,WRK1,TFJACB,OMEGA,YT,U,QRAUX,WRK2,
     +            NNZW,NPP,
     +            JOB,PARTOL,SSTOL,MAXIT,TAUFAC,EPSMAC,NETA,
     +            LUNRPT,IPR1,IPR2,IPR2F,IPR3,
     +            WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +            TAU,ALPHA,NITER,NFEV,NJEV,INT2,OLMAVG,
     +            RCOND,IRANK,ACTRS,PNORM,PRERS,RNORMS)
*
C  ENCODE EXISTANCE OF QUESTIONABLE RESULTS INTO INFO
*
      IF (INFO.LE.9) THEN
         IF (MSGB(1).EQ.2 .OR. MSGX(1).EQ.2) THEN
            INFO = INFO + 1000
         END IF
         IF (ISTOPF.NE.0) THEN
            INFO = INFO + 100
         END IF
         IF (IRANK.GE.1) THEN
            IF (NPP.GT.IRANK) THEN
               INFO = INFO + 10
            ELSE
               INFO = INFO + 20
            END IF
         END IF
      END IF
*
C  PRINT FINAL SUMMARY
*
      IF (IPR3.NE.0 .AND. LUNRPT.NE.0) THEN
         IFLAG = 3
*
         CALL DODPCR(HEAD,IFLAG,IPR3,FSTITR,DIDVCV,LUNRPT,
     +               MSGB,MSGX,
     +               N,M,NP,NPP,NNZW,
     +               X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +               BETA,IFIXB,SSF,WORK(WRK2),
     +               JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +               WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +               NITER,NFEV,NJEV,ACTRED,PRERED,
     +               TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
      END IF
*
      RETURN
*
      END
*DODPC1
      SUBROUTINE DODPC1
     +   (IPR,LUNRPT,
     +   ANAJAC,CHKJAC,INITD,RESTRT,ISODR,DOVCV,
     +   MSGB,MSGX,
     +   N,M,NP,NPP,NNZW,
     +   X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,
     +   Y,W,
     +   BETA,IFIXB,SSF,
     +   JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +   WSS,WSSDEL,WSSEPS)
C***BEGIN PROLOGUE  DODPC1
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  NONE
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE INITIAL SUMMARY REPORT
C***END PROLOGUE  DODPC1
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   PARTOL,SSTOL,TAUFAC,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IPR,JOB,LDIFX,LDTT,LDWD,LDX,LUNRPT,M,MAXIT,N,NETA,NNZW,NP,NPP
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),DELTA(N,M),SSF(NP),TT(LDTT,M),W(N),WD(LDWD,M),
     +   X(LDX,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ONE,ZERO
      INTEGER
     +   J,K,L,NPLM1
      CHARACTER FMT1*90
*
C...LOCAL ARRAYS
      CHARACTER TEMPC(10)*5
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0D0,1.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     DOUBLE PRECISION DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     CHARACTER*90 FMT1
C        A CHARACTER VARIABLE USED FOR FORMATS.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER L
C        AN INDEXING VARIABLE.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPLM1
C        THE NUMBER OF ITEMS TO PRINT PER LINE, MINUS ONE.
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     DOUBLE PRECISION SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     CHARACTER*5 TEMPC(10)
C        A TEMPORARY CHARACTER VECTOR.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     DOUBLE PRECISION WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     DOUBLE PRECISION WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPC1
*
*
C  PRINT PROBLEM SIZE SPECIFICATION
*
      WRITE (LUNRPT,1000) N,NNZW,M,NP,NPP
*
      IF (IPR.GE.2) THEN
*
C  PRINT INDEPENDENT VARIABLE DATA
*
         IF (ISODR) THEN
            WRITE (LUNRPT,2010)
         ELSE
            WRITE (LUNRPT,2020)
         END IF
         NPLM1 = 1
         DO 20 J = 1,M,NPLM1+1
            IF (.NOT.ISODR) THEN
               L = MIN(M,J+NPLM1) - J + 1
               WRITE (FMT1,7000) 6,L
               WRITE (LUNRPT,FMT1) (K,K=J,MIN(M,J+NPLM1))
               WRITE (FMT1,8000) 5,L
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,2100) (X(1,K),X(N,K),K=J,MIN(M,J+NPLM1))
            ELSE
               L = MIN(M,J+NPLM1) - J + 1
               WRITE (FMT1,7000) 20,L
               WRITE (LUNRPT,FMT1) (K,K=J,MIN(M,J+NPLM1))
               WRITE (FMT1,8000) 19,L
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,2200) (X(1,K),X(N,K),K=J,MIN(M,J+NPLM1))
               IF (IFIXX(1,1).LT.0) THEN
                  WRITE (LUNRPT,2300) ('   NO',K=1,2*L)
               ELSE
                  L = 0
                  DO 10 K=J,MIN(M,J+NPLM1)
                     L = L + 1
                     IF (IFIXX(1,K).EQ.0) THEN
                        TEMPC(2*L-1) = '  YES'
                     ELSE
                        TEMPC(2*L-1) = '   NO'
                     END IF
                     IF (LDIFX.EQ.1) THEN
                        IF (IFIXX(1,K).EQ.0) THEN
                           TEMPC(2*L) = '  YES'
                        ELSE
                           TEMPC(2*L) = '   NO'
                        END IF
                     ELSE
                        IF (IFIXX(N,K).EQ.0) THEN
                           TEMPC(2*L) = '  YES'
                        ELSE
                           TEMPC(2*L) = '   NO'
                        END IF
                     END IF
   10             CONTINUE
                  WRITE (LUNRPT,2300) (TEMPC(K),K=1,2*L)
               END IF
               WRITE (LUNRPT,2500) (DELTA(1,K),DELTA(N,K),
     +                              K=J,MIN(M,J+NPLM1))
               IF (TT(1,1).LT.0) THEN
                  WRITE (LUNRPT,2600) (ABS(TT(1,1)),ABS(TT(1,1)),
     +                                K=J,MIN(M,J+NPLM1))
               ELSE
                  IF (LDTT.EQ.1) THEN
                     WRITE (LUNRPT,2600) (TT(1,K),TT(1,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  ELSE
                     WRITE (LUNRPT,2600) (TT(1,K),TT(N,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  END IF
               END IF
               IF (WD(1,1).LT.0) THEN
                  WRITE (LUNRPT,2700) (ABS(WD(1,1)),ABS(WD(1,1)),
     +                                K=J,MIN(M,J+NPLM1))
               ELSE
                  IF (LDWD.EQ.1) THEN
                     WRITE (LUNRPT,2700) (WD(1,K),WD(1,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  ELSE
                     WRITE (LUNRPT,2700) (WD(1,K),WD(N,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  END IF
               END IF
            END IF
   20    CONTINUE
*
C  PRINT DEPENDENT VARIABLE DATA AND OBSERVATION ERROR WEIGHTS
*
         WRITE (LUNRPT,3000)
         WRITE (FMT1,8000) 19,1
         WRITE (LUNRPT,FMT1)
         WRITE (LUNRPT,3100) Y(1),Y(N)
         IF (W(1).LT.ZERO) THEN
            WRITE (LUNRPT,3200) ONE,ONE
         ELSE
            WRITE (LUNRPT,3200) W(1),W(N)
         END IF
*
C  PRINT FUNCTION PARAMETER DATA
*
         WRITE (LUNRPT,4000)
         NPLM1 = 3
         DO 50 J=1,NP,NPLM1+1
            WRITE (LUNRPT,4100) (K,K=J,MIN(NP,J+NPLM1))
            WRITE (LUNRPT,4200) (BETA(K),K=J,MIN(NP,J+NPLM1))
            L = 0
            IF (IFIXB(1).LT.0) THEN
               DO 30 K=J,MIN(NP,J+NPLM1)
                  L = L + 1
                  TEMPC(L) = '   NO'
   30          CONTINUE
            ELSE
               DO 40 K=J,MIN(NP,J+NPLM1)
                  L = L + 1
                  IF (IFIXB(K).NE.0) THEN
                     TEMPC(L) = '   NO'
                  ELSE
                     TEMPC(L) = '  YES'
                  END IF
   40          CONTINUE
            END IF
            WRITE (LUNRPT,4300) (TEMPC(K),K=1,L)
            IF (SSF(1).LT.ZERO) THEN
               WRITE (LUNRPT,4400) (ABS(SSF(1)),K=J,MIN(NP,J+NPLM1))
            ELSE
               WRITE (LUNRPT,4400) (SSF(K),K=J,MIN(NP,J+NPLM1))
            END IF
   50    CONTINUE
      END IF
*
C  PRINT JOB SPECS AND STOPPING CRITERIA
*
      WRITE (LUNRPT,5000) JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT
      IF (RESTRT) THEN
         WRITE (LUNRPT,5110)
      ELSE
         WRITE (LUNRPT,5120)
      END IF
      IF (ISODR) THEN
         IF (INITD) THEN
            WRITE (LUNRPT,5211)
         ELSE
            WRITE (LUNRPT,5212)
         END IF
      ELSE
         WRITE (LUNRPT,5220)
      END IF
      IF (DOVCV) THEN
         WRITE (LUNRPT,5310)
      ELSE
         WRITE (LUNRPT,5320)
      END IF
      IF (ANAJAC) THEN
         WRITE (LUNRPT,5410)
         IF (CHKJAC) THEN
            WRITE (LUNRPT,5411)
            IF (MSGB(1).EQ.2 .OR. MSGX(1).EQ.2) THEN
               WRITE (LUNRPT,5412)
            ELSE
               WRITE (LUNRPT,5413)
            END IF
         ELSE
            WRITE (LUNRPT,5414)
         END IF
      ELSE
         WRITE (LUNRPT,5420)
      END IF
      IF (ISODR) THEN
         WRITE (LUNRPT,5510)
      ELSE
         WRITE (LUNRPT,5520)
      END IF
*
C  PRINT INITIAL SUM OF SQUARES
*
      WRITE (LUNRPT,6000)
      WRITE (LUNRPT,6100) WSS
      IF (ISODR) THEN
         WRITE (LUNRPT,6200) WSSDEL
         WRITE (LUNRPT,6300) WSSEPS
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1000 FORMAT
     +   (///' PROBLEM SIZE:'/
     +       ' -------------'//
     +       ' NUMBER OF OBSERVATIONS                            ',I5/
     +       ' NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS       ',I5/
     +       ' NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE ',I5/
     +       ' NUMBER OF FUNCTION PARAMETERS                     ',I5/
     +       ' NUMBER OF UNFIXED FUNCTION PARAMETERS             ',I5)
 2010 FORMAT
     +   (///' INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:'/
     +       ' ----------------------------------------------')
 2020 FORMAT
     +   (///' INDEPENDENT VARIABLE SUMMARY:'/
     +       ' -----------------------------')
 2100 FORMAT
     +   (' X - ', 6D13.5)
 2200 FORMAT
     +   ('               X - ', 6D13.5)
 2300 FORMAT
     +   ('           FIXED - ', 6(8X,A5))
 2500 FORMAT
     +   ('   INITIAL DELTA - ', 6D13.5)
 2600 FORMAT
     +   ('     DELTA SCALE - ', 6D13.5)
 2700 FORMAT
     +   ('   DELTA WEIGHTS - ', 6D13.5)
 3000 FORMAT
     +   (///' DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT',
     +   ' SUMMARY:'/
     +       ' -------------------------------------------------',
     +   '---------'/)
 3100 FORMAT
     +   ('               Y - ', 6D13.5)
 3200 FORMAT
     +   (' OBS. ERROR WTS. - ', 6D13.5)
 4000 FORMAT
     +   (///' FUNCTION PARAMETER SUMMARY:'/
     +       ' ---------------------------')
 4100 FORMAT
     +   (/'        INDEX - ', 5I16)
 4200 FORMAT
     +   (' INITIAL BETA - ', 5D16.8)
 4300 FORMAT
     +   ('        FIXED - ', 5(11X,A5))
 4400 FORMAT
     +   ('   BETA SCALE - ', 5D16.8)
 5000 FORMAT
     +   (///' CONTROL VALUES AND STOPPING CRITERIA:'/
     +       ' --------------------------------------'//
     +       '       *                                     '/
     +       '    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT'/
     +       1X,I6.5,5X,I5,3D10.2,I7//' *')
 5110 FORMAT
     +   ('  A.  FIT IS A RESTART.')
 5120 FORMAT
     +   ('  A.  FIT IS NOT A RESTART.')
 5211 FORMAT
     +   ('  B.  DELTAS ARE INITIALIZED TO ZERO.')
 5212 FORMAT
     +   ('  B.  DELTAS ARE INITIALIZED BY USER.')
 5220 FORMAT
     +   ('  B.  DELTAS ARE FIXED AT ZERO.')
 5310 FORMAT
     +   ('  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS'/
     +    '      WILL BE COMPUTED AT THE SOLUTION.')
 5320 FORMAT
     +   ('  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS'/
     +    '      WILL NOT BE COMPUTED AT THE SOLUTION.')
 5410 FORMAT
     +   ('  D.  DERIVATIVES ARE SUPPLIED BY USER.')
 5411 FORMAT
     +   ('      USER-SUPPLIED DERIVATIVES WERE CHECKED.')
 5412 FORMAT
     +   ('      THE CORRECTNESS OF SOME OF THE DERIVATIVES IS'/
     +    '      QUESTIONABLE.  SEE ERROR MESSAGES FOR DETAILS.')
 5413 FORMAT
     +   ('      THE DERIVATIVES APPEAR TO BE CORRECT.')
 5414 FORMAT
     +   ('      USER-SUPPLIED DERIVATIVES WERE NOT CHECKED.')
 5420 FORMAT
     +   ('  D.  DERIVATIVES ARE COMPUTED BY FINITE DIFFERENCES.')
 5510 FORMAT
     +   ('  E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.')
 5520 FORMAT
     +   ('  E.  FIT IS BY METHOD OF ORDINARY LEAST SQUARES.')
 6000 FORMAT
     +   (///' INITIAL SUMS OF SQUARES:'/
     +       ' ------------------------'/)
 6100 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS ', D17.8)
 6200 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED DELTAS               ', D17.8)
 6300 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED EPSILONS             ', D17.8)
 7000 FORMAT
     +   ('(/',I2,'X,',I2,'(''           COLUMN '',I3,''     ''))')
 8000 FORMAT
     +   ('(',I2,'X,',I2,'(''        OBS 1        OBS N''))')
      END
*DODPC2
      SUBROUTINE DODPC2
     +   (IPR,FSTITR,LUNRPT,NP,
     +   NITER,NFEV,WSS,ACTRED,PRERED,ALPHA,TAU,PNORM,BETA)
C***BEGIN PROLOGUE  DODPC2
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE ITERATION REPORTS
C***END PROLOGUE  DODPC2
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   ACTRED,ALPHA,PNORM,PRERED,TAU,WSS
      INTEGER
     +   IPR,LUNRPT,NFEV,NITER,NP
      LOGICAL
     +   FSTITR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   RATIO,ZERO
      INTEGER
     +   J,K,L
      CHARACTER GN*3
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION ACTRED
C        THE ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL FSTITR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THIS IS THE
C        FIRST ITERATION (FSTITR=.TRUE.) OR NOT (FSTITR=.FALSE.).
C     CHARACTER*3 GN
C        THE CHARACTER VARIABLE USED TO INDICATE WHETHER A GAUSS-NEWTON
C        STEP WAS TAKEN.
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER L
C        AN INDEXING VARIABLE.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     DOUBLE PRECISION PRERED
C        THE PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION RATIO
C        THE RATIO OF TAU TO PNORM.
C     DOUBLE PRECISION TAU
C        THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPC2
*
*
      IF (FSTITR) THEN
         IF (IPR.EQ.1) THEN
            WRITE (LUNRPT,1120)
         ELSE
            WRITE (LUNRPT,1130)
         END IF
      END IF
      IF (ALPHA.EQ.ZERO) THEN
         GN = 'YES'
      ELSE
         GN = ' NO'
      END IF
      IF (PNORM.NE.ZERO) THEN
         RATIO = TAU/PNORM
      ELSE
         RATIO = ZERO
      END IF
      IF (IPR.EQ.1) THEN
         WRITE (LUNRPT,1141) NITER,NFEV,WSS,ACTRED,PRERED,
     +                       RATIO,GN
      ELSE
         J = 1
         K = MIN(3,NP)
         IF (J.EQ.K) THEN
            WRITE (LUNRPT,1141) NITER,NFEV,WSS,ACTRED,PRERED,
     +                          RATIO,GN,J,BETA(J)
         ELSE
            WRITE (LUNRPT,1142) NITER,NFEV,WSS,ACTRED,PRERED,
     +                          RATIO,GN,J,K,(BETA(L),L=J,K)
         END IF
         IF (NP.GT.3) THEN
            DO 10 J=4,NP,3
               K = MIN(J+2,NP)
               IF (J.EQ.K) THEN
                  WRITE (LUNRPT,1151) J,BETA(J)
               ELSE
                  WRITE (LUNRPT,1152) J,K,(BETA(L),L=J,K)
               END IF
   10       CONTINUE
         END IF
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1120 FORMAT
     +   (//
     +    '         CUM.                 ACT. REL.   PRED. REL.'/
     +    '  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS',
     +    '              G-N'/
     +    ' NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION',
     +    '  TAU/PNORM  STEP'/
     +    ' ----  ------  -----------  -----------  -----------',
     +    '  ---------  ----'/)
 1130 FORMAT
     +   (//
     +    '         CUM.                 ACT. REL.   PRED. REL.'/
     +    '  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS',
     +    '              G-N      BETA -------------->'/
     +    ' NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION',
     +    '  TAU/PNORM  STEP     INDEX           VALUE'/
     +    ' ----  ------  -----------  -----------  -----------',
     +    '  ---------  ----     -----           -----'/)
 1141 FORMAT
     +   (1X,I4,I8,1X,D12.5,2D13.4,D11.3,3X,A3,7X,I3,3D16.8)
 1142 FORMAT
     +   (1X,I4,I8,1X,D12.5,2D13.4,D11.3,3X,A3,1X,I3,' TO',I3,3D16.8)
 1151 FORMAT
     +   (76X,I3,D16.8)
 1152 FORMAT
     +   (70X,I3,' TO',I3,3D16.8)
      END
*DODPC3
      SUBROUTINE DODPC3
     +   (IPR,LUNRPT,
     +   N,M,NP,NPP,
     +   INFO,NITER,NFEV,NJEV,RCOND,IRANK,
     +   WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +   BETA,SDBETA,IFIXB,F,ISODR,DIDVCV,DOVCV,ANAJAC,DELTA)
C***BEGIN PROLOGUE  DODPC3
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  NONE
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE FINAL SUMMARY REPORT
C***END PROLOGUE  DODPC3
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   RCOND,RVAR,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IDF,INFO,IPR,IRANK,LUNRPT,M,N,NFEV,NITER,NJEV,NP,NPP
      LOGICAL
     +   ANAJAC,DIDVCV,DOVCV,ISODR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),DELTA(N,M),F(N),SDBETA(NP)
      INTEGER
     +   IFIXB(NP)
*
C...LOCAL SCALARS
      INTEGER
     +   D1,D2,D3,D4,D5,I,J,K,L,LAST,MAXLST,NPLM1
      CHARACTER FMT1*90
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MIN,MOD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER D1
C        THE FIRST DIGIT OF INFO.
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER D4
C        THE FOURTH DIGIT OF INFO.
C     INTEGER D5
C        THE FIFTH DIGIT OF INFO.
C     DOUBLE PRECISION DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DIDVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX WAS COMPUTED (DIDVCV=.TRUE.)
C        OR NOT (DIDVCV=.FALSE.).
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     DOUBLE PRECISION F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     CHARACTER*90 FMT1
C        A CHARACTER VARIABLE USED FOR FORMATS.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER L
C        AN INDEXING VARIABLE.
C     INTEGER LAST
C        THE LAST ROW OF THE GIVEN ARRAY TO BE PRINTED.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXLST
C        THE MAXIMUM NUMBER OF ITEMS TO BE PRINTED.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPLM1
C        THE NUMBER OF ITEMS TO BE PRINTED PER LINE, MINUS ONE.
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     DOUBLE PRECISION RVAR
C        THE RESIDUAL VARIANCE.
C     DOUBLE PRECISION SDBETA(NP)
C        THE STANDARD ERRORS OF THE ESTIMATED PARAMETERS.
C     DOUBLE PRECISION WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     DOUBLE PRECISION WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     DOUBLE PRECISION WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPC3
*
*
      D1 = INFO/10000
      D2 = MOD(INFO,10000)/1000
      D3 = MOD(INFO,1000)/100
      D4 = MOD(INFO,100)/10
      D5 = MOD(INFO,10)
*
C  PRINT STOPPING CONDITIONS
*
      WRITE (LUNRPT,1000) INFO
      IF (D1.EQ.5) THEN
         IF (D2.NE.0) THEN
            WRITE (LUNRPT,1110)
         ELSE IF (D3.NE.0) THEN
            WRITE (LUNRPT,1115)
         END IF
      ELSE
         IF (D5.EQ.1) THEN
            WRITE (LUNRPT,1120)
         ELSE IF (D5.EQ.2) THEN
            WRITE (LUNRPT,1130)
         ELSE IF (D5.EQ.3) THEN
            WRITE (LUNRPT,1140)
         ELSE IF (D5.EQ.4) THEN
            WRITE (LUNRPT,1150)
         ELSE
            WRITE (LUNRPT,1160)
         END IF
*
C  PRINT WARNING DIAGNOSTICS
*
         IF (D2.NE.0 .OR. D3.NE.0 .OR. D4.NE.0) THEN
            WRITE (LUNRPT,1210)
            IF (D2.NE.0) THEN
               IF (D3.NE.0 .OR. D4.NE.0) THEN
                  WRITE (LUNRPT,1220) ', AND'
               ELSE
                  WRITE (LUNRPT,1220) '.    '
               END IF
            END IF
            IF (D3.NE.0) THEN
               IF (D4.NE.0) THEN
                  WRITE (LUNRPT,1230) ', AND'
               ELSE
                  WRITE (LUNRPT,1230) '.    '
               END IF
            END IF
            IF (D4.EQ.1) THEN
               WRITE (LUNRPT,1240)
            END IF
            IF (D4.EQ.2) THEN
               WRITE (LUNRPT,1250)
            END IF
         END IF
      END IF
*
C  PRINT MISC. STOPPING INFO
*
      IF (ANAJAC) THEN
         WRITE (LUNRPT,1300) NITER,NFEV,NJEV,RCOND,IRANK
      ELSE
         WRITE (LUNRPT,1400) NITER,NFEV,RCOND,IRANK
      END IF
*
C  PRINT FINAL SUM OF SQUARES
*
      WRITE (LUNRPT,2000)
      WRITE (LUNRPT,2100) WSS
      IF (ISODR) THEN
         WRITE (LUNRPT,2200) WSSDEL
         WRITE (LUNRPT,2300) WSSEPS
      END IF
      IF (DIDVCV) THEN
         WRITE (LUNRPT,2400) RVAR
         WRITE (LUNRPT,2500) IDF
      END IF
*
      NPLM1 = 3
*
C  PRINT ESTIMATED BETA'S, AND,
C  IF, FULL RANK, THEIR STANDARD ERRORS
*
      WRITE (LUNRPT,3000)
      IF (DIDVCV) THEN
         WRITE (LUNRPT,7300)
*
         DO 10 J=1,NP
            IF (NP.EQ.NPP) THEN
               WRITE (LUNRPT,8100) J,BETA(J),SDBETA(J)
            ELSE
               IF (IFIXB(J).EQ.0) THEN
                  WRITE (LUNRPT,8400) J,BETA(J)
               ELSE
                  WRITE (LUNRPT,8100) J,BETA(J),SDBETA(J)
               END IF
            END IF
   10    CONTINUE
      ELSE
         IF (DOVCV) WRITE (LUNRPT,7400)
         IF (NP.EQ.1) THEN
            WRITE (LUNRPT,7100)
         ELSE
            WRITE (LUNRPT,7200)
         END IF
*
         DO 20 J=1,NP,NPLM1+1
            K = MIN(J+NPLM1,NP)
            IF (K.EQ.J) THEN
               WRITE (LUNRPT,8100) J,BETA(J)
            ELSE
               WRITE (LUNRPT,8200) J,K,(BETA(L),L=J,K)
            END IF
   20    CONTINUE
      END IF
*
C  PRINT ESTIMATED EPSILON'S AND DELTA'S
*
      MAXLST = 32
      IF (IPR.GE.2 .OR. N.LT.MAXLST) THEN
         LAST = N
      ELSE
         LAST = MAXLST
      END IF
*
C  PRINT EPSILON'S AND DELTA'S TOGETHER IN A COLUMN IF THE NUMBER OF
C  COLUMNS OF DATA IN DELTA IS LESS THAN OR EQUAL TO THREE.
*
      IF (ISODR .AND. M.LE.3) THEN
         WRITE (LUNRPT,4100)
         WRITE (FMT1,9100) M
         WRITE (LUNRPT,FMT1) (J,J=1,M)
         DO 30 I=1,LAST
            WRITE (LUNRPT,4110) I,F(I),(DELTA(I,J),J=1,M)
   30    CONTINUE
         IF (N.GT.LAST) THEN
            IF (N.LE.LAST+4) THEN
               DO 40 I=LAST+1,N
                  WRITE (LUNRPT,4110) I,F(I),(DELTA(I,J),J=1,M)
   40          CONTINUE
            ELSE
               WRITE (FMT1,9200) M+1
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,4110) N,F(N),(DELTA(N,J),J=1,M)
            END IF
         END IF
      ELSE
*
C  PRINT EPSILON'S AND DELTA'S SEPARATELY
*
C  PRINT EPSILON'S
*
         WRITE (LUNRPT,4200)
         IF (LAST.EQ.1) THEN
            WRITE (LUNRPT,7100)
         ELSE
            WRITE (LUNRPT,7200)
         END IF
         DO 50 I=1,LAST,NPLM1+1
            K = MIN(I+NPLM1,LAST)
            IF (I.EQ.K) THEN
               WRITE (LUNRPT,8100) I,F(I)
            ELSE
               WRITE (LUNRPT,8200) I,K,(F(L),L=I,K)
            END IF
   50    CONTINUE
         IF (N.GT.LAST) THEN
            IF (N.EQ.LAST+1) THEN
               WRITE (LUNRPT,8100) N,F(N)
            ELSE IF (N.GT.LAST+1) THEN
               WRITE (LUNRPT,8300) N,F(N)
            END IF
         END IF
*
C  PRINT DELTA'S
*
         IF (ISODR) THEN
            DO 70 J=1,M
               WRITE (LUNRPT,4300) J
               IF (LAST.EQ.1) THEN
                  WRITE (LUNRPT,7100)
               ELSE
                  WRITE (LUNRPT,7200)
               END IF
               DO 60 I=1,LAST,NPLM1+1
                  K = MIN(I+NPLM1,LAST)
                  IF (I.EQ.K) THEN
                     WRITE (LUNRPT,8100) I,DELTA(I,J)
                  ELSE
                     WRITE (LUNRPT,8200) I,K,(DELTA(L,J),L=I,K)
                  END IF
   60          CONTINUE
               IF (N.EQ.LAST+1) THEN
                  WRITE (LUNRPT,8100) N,DELTA(N,J)
               ELSE IF (N.GT.LAST+1) THEN
                  WRITE (LUNRPT,8300) N,DELTA(N,J)
               END IF
   70       CONTINUE
         END IF
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1000 FORMAT
     +   (///' STOPPING CONDITION (INFO = ',I6,'):'/
     +       ' -----------------------------------'/)
 1110 FORMAT
     +   (   ' THE COMPUTATIONS WERE STOPPED BY THE USER DURING'/
     +       ' THE EVALUATION OF THE FUNCTION')
 1115 FORMAT
     +   (   ' THE COMPUTATIONS WERE STOPPED BY THE USER DURING'/
     +       ' THE EVALUATION OF THE JACOBIAN')
 1120 FORMAT
     +   (   ' THE RELATIVE CHANGE IN THE SUM OF THE SQUARED'/
     +       ' WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL')
 1130 FORMAT
     +   (   ' THE RELATIVE CHANGE IN THE NORM OF BETA AND DELTA'/
     +       ' IS LESS THAN PARTOL')
 1140 FORMAT
     +   (   ' THE RELATIVE CHANGE IN THE SUM OF THE SQUARED'/
     +       ' WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL'/
     +       ' AND'/
     +       ' THE RELATIVE CHANGE IN THE NORM OF BETA AND DELTA'/
     +       ' IS LESS THAN PARTOL')
 1150 FORMAT
     +   (   ' MAXIMUM NUMBER OF ITERATIONS REACHED')
 1160 FORMAT
     +   (   ' ERROR.  PLEASE CHECK WITH AUTHORS.')
 1210 FORMAT
     +   (/  ' NOTE:'//
     +       ' THE RESULTS FROM ODRPACK ARE QUESTIONABLE BECAUSE'/)
 1220 FORMAT
     +   (   ' THE ODRPACK JACOBIAN MATRIX CHECKING PROCEDURE HAS  '/
     +       ' DETERMINED THAT THE CORRECTNESS OF THE USER-SUPPLIED'/
     +       ' JACOBIAN MATRICES IS QUESTIONABLE',A5/)
 1230 FORMAT
     +   (   ' THE MOST RECENTLY TRIED STEP WAS REJECTED BY THE    '/
     +       ' USER AS INDICATED BY THE VALUE OF VARIABLE ISTOPF   '/
     +       ' RETURNED FROM USER-SUPPLIED SUBROUTINE FUN',A5/)
 1240 FORMAT
     +   (   ' THE JACOBIAN OF THE MODEL FUNCTION WITH RESPECT TO  '/
     +       ' THE FUNCTION PARAMETERS (BETA) IS NOT FULL RANK AT  '/
     +       ' THE SOLUTION. ')
 1250 FORMAT
     +   (   ' THE RESULTS OF THE MODEL FUNCTION AND/OR ITS        '/
     +       ' DERIVATIVES ARE UNAFFECTED BY CHANGES IN THE UNFIXED'/
     +       ' FUNCTION PARAMETERS (BETA), INDICATING A PROBABLE   '/
     +       ' ERROR IN USER-SUPPLIED SUBROUTINES FUN AND/OR JAC.'/)
 1300 FORMAT
     +  (/'                                       CONDITION',
     +       '            '/
     +    '       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER',
     +       '        RANK'/
     +    '      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)',
     +       '  DEFICIENCY'/
     +    6X,I10,2I11,D11.4,6X,I6)
 1400 FORMAT
     +  (/'                             CONDITION            '/
     +    '       NUMBER OF  NUMBER OF     NUMBER        RANK'/
     +    '      ITERATIONS   FN EVALS  (INVERSE)  DEFICIENCY'/
     +    6X,I10,I11,D11.4,6X,I6)
 2000 FORMAT
     +   (///' FINAL SUMS OF SQUARES:'/
     +       ' ----------------------'/)
 2100 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS ', D17.8)
 2200 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED DELTAS               ', D17.8)
 2300 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED EPSILONS             ', D17.8)
 2400 FORMAT
     +   (/  ' ESTIMATED RESIDUAL VARIANCE                  ', D17.8)
 2500 FORMAT
     +   (   ' (',I5,' DEGREES OF FREEDOM)')
 3000 FORMAT
     +   (///' ESTIMATED BETA(J), J = 1, ..., NP:'/
     +       ' ----------------------------------')
 4100 FORMAT
     +   (///' ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:'/
     +       ' ---------------------------------------------------')
 4110 FORMAT(1X,I5,5D16.8)
 4200 FORMAT
     +   (///' ESTIMATED EPSILON(I), I = 1, ..., N:'/
     +      ' ------------------------------------')
 4300 FORMAT
     +   (///' ESTIMATED DELTA(I,',I3,'), I = 1, ..., N:'/
     +      ' --------------------------------------')
 7100 FORMAT
     +   (/'         INDEX            VALUE')
 7200 FORMAT
     +   (/'         INDEX            VALUE -------------->')
 7300 FORMAT
     +   (/'             J          BETA(J)     STD. DEV. BETA(J)')
 7400 FORMAT
     +   (/' N.B. STANDARD ERRORS OF THE ESTIMATED BETAS WERE NOT'/
     +     '      COMPUTED BECAUSE EITHER THE JACOBIAN IS NOT FULL'/
     +     '      RANK AT THE SOLUTION, OR THE MOST RECENTLY TRIED'/
     +     '      VALUES OF BETA AND/OR X+DELTA WERE UNACCEPTABLE.')
 8100 FORMAT
     +   (9X,I5,1X,D16.8,6X,D16.8)
 8200 FORMAT
     +   (1X,I5,' TO',I5,1X,7D16.8)
 8300 FORMAT
     +   (1X,'  ... TO',I5,1X,'      ...       ',D16.8)
 8400 FORMAT
     +   (9X,I5,1X,D16.8,17X,'FIXED')
 9100 FORMAT
     +   ('(/''     I      EPSILON(I)'',',I1,
     +    '(''      DELTA(I,'',I1,'')''))')
 9200 FORMAT('(5X,''.'',',I1,'(3X,''.'',12X))')
      END
*DODPCR
      SUBROUTINE DODPCR
     +   (HEAD,IFLAG,IPR,FSTITR,DIDVCV,LUNRPT,
     +   MSGB,MSGX,
     +   N,M,NP,NPP,NNZW,
     +   X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +   BETA,IFIXB,SSF,SDBETA,
     +   JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +   WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +   NITER,NFEV,NJEV,ACTRED,PRERED,
     +   TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
C***BEGIN PROLOGUE  DODPCR
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DFLAGS,DODPC1,DODPC2,DODPC3,DODPHD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE COMPUTATION REPORTS
C***END PROLOGUE  DODPCR
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   ACTRED,ALPHA,PARTOL,PNORM,PRERED,RCOND,RVAR,
     +   SSTOL,TAU,TAUFAC,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IDF,IFLAG,INFO,IPR,IRANK,JOB,LDIFX,LDTT,LDWD,LDX,LUNRPT,M,
     +   MAXIT,N,NETA,NFEV,NITER,NJEV,NNZW,NP,NPP
      LOGICAL
     +   ANAJAC,CHKJAC,DIDVCV,DOVCV,FSTITR,HEAD,INITD,ISODR,RESTRT
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),DELTA(N,M),F(N),
     +   SDBETA(NP),SSF(NP),TT(LDTT,M),W(N),WD(LDWD,M),X(LDX,M),
     +   Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      CHARACTER TYP*3
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DFLAGS,DODPC1,DODPC2,DODPC3,DODPHD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION ACTRED
C        THE ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     DOUBLE PRECISION DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DIDVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX WAS COMPUTED (DIDVCV=.TRUE.)
C        OR NOT (DIDVCV=.FALSE.).
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     DOUBLE PRECISION F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     LOGICAL FSTITR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THIS IS THE
C        FIRST ITERATION (FSTITR=.TRUE.) OR NOT (FSTITR=.FALSE.).
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFLAG
C        AN INDICATOR VARIABLE, USED HERE TO DESIGNATE WHICH PART OF
C        THE REPORT IS TO BE PRINTED.
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     DOUBLE PRECISION PRERED
C        THE PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     DOUBLE PRECISION RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     DOUBLE PRECISION RVAR
C        THE RESIDUAL VARIANCE.
C     DOUBLE PRECISION SDBETA(NP)
C        THE STANDARD DEVIATIONS OF THE ESTIMATED BETA'S.
C     DOUBLE PRECISION SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TAU
C        THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     CHARACTER*3 TYP
C        THE CHARACTER STRING ODR OR OLS.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     DOUBLE PRECISION WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     DOUBLE PRECISION WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  DODPCR
*
*
      CALL DFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
*
      IF (HEAD) THEN
         CALL DODPHD(HEAD,LUNRPT)
      ELSE IF (IFLAG.NE.2 .OR. FSTITR) THEN
         WRITE (LUNRPT,1000)
      END IF
      IF (ISODR) THEN
         TYP = 'ODR'
      ELSE
         TYP = 'OLS'
      END IF
*
C  PRINT INITIAL SUMMARY
*
      IF (IFLAG.EQ.1) THEN
         IF (RESTRT) THEN
            WRITE (LUNRPT,1100) TYP
         ELSE
            WRITE (LUNRPT,1200) TYP
            CALL DODPC1
     +         (IPR,LUNRPT,
     +         ANAJAC,CHKJAC,INITD,RESTRT,ISODR,DOVCV,
     +         MSGB,MSGX,
     +         N,M,NP,NPP,NNZW,
     +         X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,
     +         Y,W,
     +         BETA,IFIXB,SSF,
     +         JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +         WSS,WSSDEL,WSSEPS)
         END IF
*
C  PRINT ITERATION REPORTS
*
      ELSE IF (IFLAG.EQ.2) THEN
*
         IF (FSTITR) THEN
            WRITE (LUNRPT,1300) TYP
         END IF
         CALL DODPC2
     +      (IPR,FSTITR,LUNRPT,NP,
     +      NITER,NFEV,WSS,ACTRED,PRERED,ALPHA,TAU,PNORM,BETA)
*
C  PRINT FINAL SUMMARY
*
      ELSE IF (IFLAG.EQ.3) THEN
*
         WRITE (LUNRPT,1400) TYP
         CALL DODPC3
     +      (IPR,LUNRPT,
     +      N,M,NP,NPP,
     +      INFO,NITER,NFEV,NJEV,RCOND,IRANK,
     +      WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +      BETA,SDBETA,IFIXB,F,ISODR,DIDVCV,DOVCV,ANAJAC,DELTA)
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1000 FORMAT(//)
 1100 FORMAT
     +   (////' RESTART OF FIT BY METHOD OF ',A3/
     +     ' ===============================')
 1200 FORMAT
     +   (////' INITIAL SUMMARY FOR FIT BY METHOD OF ',A3/
     +     ' ========================================')
 1300 FORMAT
     +   (//' ITERATION REPORTS FOR FIT BY METHOD OF ',A3/
     +     ' ==========================================')
 1400 FORMAT
     +   (////' FINAL SUMMARY FOR FIT BY METHOD OF ',A3/
     +     ' ======================================')
      END
*DODPE1
      SUBROUTINE DODPE1
     +   (UNIT,D1,D2,D3,D4,D5,
     +   N,
     +   LDSCLD,LDWD,
     +   LWKMN,LIWKMN)
C***BEGIN PROLOGUE  DODPE1
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PRINT ERROR REPORTS.
C***END PROLOGUE  DODPE1
*
C...SCALAR ARGUMENTS
      INTEGER
     +   D1,D2,D3,D4,D5,LDSCLD,LDWD,LIWKMN,LWKMN,N,UNIT
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER D1
C        THE FIRST DIGIT OF INFO.
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER D4
C        THE FOURTH DIGIT OF INFO.
C     INTEGER D5
C        THE FIFTH DIGIT OF INFO.
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPE1
*
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN PROBLEM SPECIFICATION
C  PARAMETERS
*
      IF (D1.EQ.1) THEN
         IF (D2.NE.0) THEN
            WRITE(UNIT,1100)
         END IF
         IF (D3.NE.0) THEN
            WRITE(UNIT,1200)
         END IF
         IF (D4.NE.0) THEN
            WRITE(UNIT,1300)
         END IF
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN DIMENSION SPECIFICATION
C  PARAMETERS
*
      ELSE IF (D1.EQ.2) THEN
         IF (D2.NE.0) THEN
            WRITE(UNIT,2100)
         END IF
         IF (D3.NE.0) THEN
            IF (D3.EQ.1 .OR. D3.EQ.3 .OR. D3.EQ.5 .OR. D3.EQ.7) THEN
               WRITE(UNIT,2210)
            END IF
            IF (D3.EQ.2 .OR. D3.EQ.3 .OR. D3.EQ.6 .OR. D3.EQ.7) THEN
               WRITE(UNIT,2220)
            END IF
            IF (D3.EQ.4 .OR. D3.EQ.5 .OR. D3.EQ.6 .OR. D3.EQ.7) THEN
               WRITE(UNIT,2230)
            END IF
         END IF
         IF (D4.NE.0) THEN
            WRITE(UNIT,2300) LWKMN
         END IF
         IF (D5.NE.0) THEN
            WRITE(UNIT,2400) LIWKMN
         END IF
*
      ELSE IF (D1.EQ.3) THEN
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS SCALE VALUES
*
         IF (D2.NE.0) THEN
            IF (LDSCLD.GE.N) THEN
               WRITE(UNIT,3110)
            ELSE
               WRITE(UNIT,3120)
            END IF
         END IF
         IF (D3.NE.0) THEN
            WRITE(UNIT,3130)
         END IF
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN OBSERVATIONAL ERROR WEIGHTS
*
         IF (D4.NE.0) THEN
            IF (D4.EQ.1) THEN
               WRITE(UNIT,3210)
            ELSE
               WRITE(UNIT,3220)
            END IF
         END IF
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN DELTA WEIGHTS
*
         IF (D5.NE.0) THEN
            IF (LDWD.GE.N) THEN
               WRITE(UNIT,3310)
            ELSE
               WRITE(UNIT,3320)
            END IF
         END IF
*
      END IF
*
C  FORMAT STATEMENTS
*
 1100 FORMAT
     +   (/' ERROR :  N IS LESS THAN ONE.')
 1200 FORMAT
     +   (/' ERROR :  M IS LESS THAN ONE.')
 1300 FORMAT
     +   (/' ERROR :  NP IS LESS THAN ONE'/
     +     '          OR NP IS GREATER THAN N.')
 2100 FORMAT
     +   (/' ERROR :  LDX IS LESS THAN N.')
 2210 FORMAT
     +   (/' ERROR :  LDIFX IS LESS THAN N'/
     +     '          AND LDIFX IS NOT EQUAL TO ONE.')
 2220 FORMAT
     +   (/' ERROR :  LDSCLD IS LESS THAN N'/
     +     '          AND LDSCLD IS NOT EQUAL TO ONE.')
 2230 FORMAT
     +   (/' ERROR :  LDWD IS LESS THAN N'/
     +     '          AND LDWD IS NOT EQUAL TO ONE.')
 2300 FORMAT
     +   (/' ERROR :  LWORK IS LESS THAN ',I5, ','/
     +     '          THE SMALLEST ACCEPTABLE DIMENSION OF ARRAY WORK.')
 2400 FORMAT
     +   (/' ERROR :  LIWORK IS LESS THAN ',I5, ','/
     +     '          THE SMALLEST ACCEPTABLE DIMENSION OF ARRAY',
     +              ' IWORK.')
 3110 FORMAT
     +   (/' ERROR :  SCLD(I,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME I = 1, ..., N AND J = 1, ..., M.'//
     +     '          WHEN SCLD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDSCLD IS GREATER THAN OR EQUAL TO N THEN'/
     +     '          EACH OF THE N BY M ELEMENTS OF'/
     +     '          SCLD MUST BE GREATER THAN ZERO.')
 3120 FORMAT
     +   (/' ERROR :  SCLD(1,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME J = 1, ..., M.'//
     +     '          WHEN SCLD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDSCLD IS EQUAL TO ONE THEN'/
     +     '          EACH OF THE 1 BY M ELEMENTS OF'/
     +     '          SCLD MUST BE GREATER THAN ZERO.')
 3130 FORMAT
     +   (/' ERROR :  SCLB(K) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME K = 1, ..., NP.'//
     +     '          ALL NP ELEMENTS OF',
     +              ' SCLB MUST BE GREATER THAN ZERO.')
 3210 FORMAT
     +   (/' ERROR :  W(I) IS LESS THAN ZERO FOR SOME I = 1, ..., N.'//
     +     '          WHEN W(1) IS GREATER THAN OR EQUAL TO ZERO THEN'/
     +     '          ALL N ELEMENTS OF',
     +              ' W MUST BE GREATER THAN OR EQUAL TO ZERO.')
 3220 FORMAT
     +   (/' ERROR :  THE NUMBER OF NONZERO VALUES IN ARRAY W IS'/
     +     '          LESS THAN NP.')
 3310 FORMAT
     +   (/' ERROR :  WD(I,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME I = 1, ..., N AND J = 1, ..., M.'//
     +     '          WHEN WD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDWD IS GREATER THAN OR EQUAL TO N THEN'/
     +     '          EACH OF THE N BY M ELEMENTS OF'/
     +     '          WD MUST BE GREATER THAN ZERO.')
 3320 FORMAT
     +   (/' ERROR :  WD(1,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME J = 1, ..., M.'//
     +     '          WHEN WD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDWD IS EQUAL TO ONE THEN'/
     +     '          EACH OF THE 1 BY M ELEMENTS OF'/
     +     '          WD MUST BE GREATER THAN ZERO.')
      END
*DODPE2
      SUBROUTINE DODPE2
     +   (UNIT,
     +   NP,M,
     +   MSGB,ISODR,MSGX,
     +   XPLUSD,LDXPD,NROW,NETA,NTOL)
C***BEGIN PROLOGUE  DODPE2
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE THE DERIVATIVE CHECKING REPORT
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKZRO)
C***END PROLOGUE  DODPE2
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDXPD,M,NETA,NP,NROW,NTOL,UNIT
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   XPLUSD(LDXPD,M)
      INTEGER
     +   MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      INTEGER
     +   I,J,K
      CHARACTER TYP*3
*
C...LOCAL ARRAYS
      LOGICAL
     +   FTNOTE(6)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL FTNOTE(6)
C        THE ARRAY WHICH CONTROLS PRINTING OF FOOTNOTES.
C     INTEGER I
C        AN INDEX VARIABLE.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER K
C        AN INDEX VARIABLE.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER NETA
C        THE NUMBER OF RELIABLE DIGITS IN THE MODEL.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        FINITE DIFFERENCE AND THE USER-SUPPLIED DERIVATIVES.
C     CHARACTER*3 TYP
C        THE SOLUTION TYPE, ODR OR OLS.
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPE2
*
*
C  SET UP FOR FOOTNOTES
*
      DO 10 I=1,6
         FTNOTE(I) = .FALSE.
   10 CONTINUE
*
      IF (MSGB(1).GE.1) THEN
         DO 20 I=1,NP
            IF (MSGB(I+1).GE.2) THEN
               FTNOTE(1) = .TRUE.
               FTNOTE(MSGB(I+1)) = .TRUE.
            END IF
   20    CONTINUE
      END IF
*
      IF (MSGX(1).GE.1) THEN
         DO 30 I=1,M
            IF (MSGX(I+1).GE.2) THEN
               FTNOTE(1) = .TRUE.
               FTNOTE(MSGX(I+1)) = .TRUE.
            END IF
   30    CONTINUE
      END IF
*
C     PRINT REPORT
*
      IF (ISODR) THEN
         TYP = 'ODR'
      ELSE
         TYP = 'OLS'
      END IF
      WRITE (UNIT,1000) TYP
      IF (FTNOTE(1)) WRITE (UNIT,2100)
      WRITE (UNIT,2200)
*
*
      DO 40 I=1,NP
         K = MSGB(I+1) - 1
         IF (K.EQ.(-1)) WRITE (UNIT,3100) I
         IF (K.EQ.0) WRITE (UNIT,3200) I
         IF (K.GE.1) WRITE (UNIT,3300) I, K
   40 CONTINUE
      IF (ISODR) THEN
         DO 50 I=1,M
            K = MSGX(I+1) - 1
            IF (K.EQ.(-1)) WRITE (UNIT,4100) NROW,I
            IF (K.EQ.0) WRITE (UNIT,4200) NROW,I
            IF (K.GE.1) WRITE (UNIT,4300) NROW,I,K
   50    CONTINUE
      END IF
*
C     PRINT FOOTNOTES
*
      IF (FTNOTE(1)) THEN
*
         WRITE (UNIT,5100)
         IF (FTNOTE(2)) WRITE (UNIT,5200)
         IF (FTNOTE(3)) WRITE (UNIT,5300)
         IF (FTNOTE(4)) WRITE (UNIT,5400)
         IF (FTNOTE(5)) WRITE (UNIT,5500)
         IF (FTNOTE(6)) WRITE (UNIT,5600)
      END IF
*
      WRITE (UNIT,6000) NETA
      WRITE (UNIT,7000) NTOL
*
C  PRINT OUT ROW OF INDEPENDENT VARIABLE WHICH WAS CHECKED.
*
      WRITE (UNIT,8100) NROW
*
      DO 60 J=1,M
         WRITE (UNIT,8110) NROW,J,XPLUSD(NROW,J)
   60 CONTINUE
*
      RETURN
*
C     FORMAT STATEMENTS
*
 1000 FORMAT
     +   (//' DERIVATIVE CHECKING REPORT FOR FIT BY METHOD OF ',A3/
     +     ' ==================================================='/)
 2100 FORMAT ('                                    *')
 2200 FORMAT ('                          DERIVATIVE '/
     +        '       DERIVATIVE WRT     ASSESSMENT '/)
 3100 FORMAT ('            BETA(',I3,')         OK     ')
 3200 FORMAT ('            BETA(',I3,')      INCORRECT  ')
 3300 FORMAT ('            BETA(',I3,')    QUESTIONABLE (',I1,')')
 4100 FORMAT ('             X(',I2,',',I2,')         OK     ')
 4200 FORMAT ('             X(',I2,',',I2,')      INCORRECT  ')
 4300 FORMAT ('             X(',I2,',',I2,')    QUESTIONABLE (',I1,')')
 5100 FORMAT
     +   (/' *'/
     +     '  NUMBERS IN PARENTHESES REFER TO THE FOLLOWING NOTES.')
 5200 FORMAT
     +   (/'  (1) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      AGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE BOTH'/
     +     '      ARE ZERO.')
 5300 FORMAT
     +   (/'  (2) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      AGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE USER-'/
     +     '      SUPPLIED DERIVATIVE IS IDENTICALLY ZERO AND FINITE '/
     +     '      DIFFERENCE DERIVATIVE IS ONLY APPROXIMATELY ZERO.')
 5400 FORMAT
     +   (/'  (3) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      DISAGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE'/
     +     '      USER-SUPPLIED DERIVATIVE IS IDENTICALLY ZERO.')
 5500 FORMAT
     +   (/'  (4) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      DISAGREE, BUT FINITE DIFFERENCE DERIVATIVE IS'/
     +     '      QUESTIONABLE BECAUSE EITHER THE RATIO OF RELATIVE'/
     +     '      CURVATURE TO RELATIVE SLOPE IS TOO HIGH OR THE SCALE'/
     +     '      IS WRONG.')
 5600 FORMAT
     +   (/'  (5) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      DISAGREE, BUT FINITE DIFFERENCE DERIVATIVE IS'/
     +     '      QUESTIONABLE BECAUSE THE RATIO OF RELATIVE CURVATURE'/
     +     '      TO RELATIVE SLOPE IS TOO HIGH.')
 6000 FORMAT
     *   (/' NUMBER OF RELIABLE DIGITS IN FUNCTION RESULTS       ',I5)
 7000 FORMAT
     +   (/' NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN      '/
     +     ' USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVE FOR  '/
     +     ' USER-SUPPLIED DERIVATIVE TO BE CONSIDERED CORRECT   ',I5)
 8100 FORMAT
     +   (/' ROW NUMBER AT WHICH DERIVATIVES WERE CHECKED        ',I5//
     +     '   -VALUES OF THE INDEPENDENT VARIABLES AT THIS ROW'/)
 8110 FORMAT
     +   (6X,'X(',I2,',',I2,')',1X,3D16.8)
      END
*DODPE3
      SUBROUTINE DODPE3
     +   (UNIT,D2,D3)
C***BEGIN PROLOGUE  DODPE3
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PRINT ERROR REPORTS TO INDICATE THAT COMPUTATIONS WERE
C            STOPPED IN USER-SUPPLIED SUBROUTINES FUN AND/OR JAC.
C***END PROLOGUE  DODPE3
*
C...SCALAR ARGUMENTS
      INTEGER
     +   D2,D3,UNIT
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPE3
*
*
C  PRINT APPROPRIATE MESSAGES TO INDICATE WHERE COMPUTATIONS WERE
C  STOPPED
*
      IF (D2.EQ.2) THEN
         WRITE(UNIT,1100)
      ELSE IF (D2.EQ.3) THEN
         WRITE(UNIT,1200)
      ELSE IF (D2.EQ.4) THEN
         WRITE(UNIT,1300)
      END IF
      IF (D3.EQ.2) THEN
         WRITE(UNIT,1400)
      END IF
*
C  FORMAT STATEMENTS
*
 1100 FORMAT
     +   (//' VARIABLE ISTOPF HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE FUN WHEN INVOKED USING THE'/
     +      ' INITIAL ESTIMATES OF BETA AND DELTA SUPPLIED BY THE     '/
     +      ' USER.  THE INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW  '/
     +      ' PROPER EVALUATION OF SUBROUTINE FUN BEFORE THE          '/
     +      ' REGRESSION PROCEDURE CAN CONTINUE.')
 1200 FORMAT
     +   (//' VARIABLE ISTOPF HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE FUN.  THIS OCCURRED DURING'/
     +      ' THE COMPUTATION OF THE NUMBER OF RELIABLE DIGITS IN THE '/
     +      ' PREDICTED VALUES (F) RETURNED FROM SUBROUTINE FUN, INDI-'/
     +      ' CATING THAT CHANGES IN THE INITIAL ESTIMATES OF BETA(K),'/
     +      ' K=1,NP, AS SMALL AS 2*BETA(K)*SQRT(MACHINE PRECISION),  '/
     +      ' WHERE MACHINE PRECISION IS DEFINED AS THE SMALLEST VALUE'/
     +      ' E SUCH THAT 1+E>1 ON THE COMPUTER BEING USED, PREVENT   '/
     +      ' SUBROUTINE FUN FROM BEING PROPERLY EVALUATED.  THE      '/
     +      ' INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW PROPER      '/
     +      ' EVALUATION OF SUBROUTINE FUN DURING THESE COMPUTATIONS  '/
     +      ' BEFORE THE REGRESSION PROCEDURE CAN CONTINUE.')
 1300 FORMAT
     +   (//' VARIABLE ISTOPF HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE FUN.  THIS OCCURRED DURING'/
     +      ' THE DERIVATIVE CHECKING PROCEDURE, INDICATING THAT      '/
     +      ' CHANGES IN THE INITIAL ESTIMATES OF BETA(K), K=1,NP, AS '/
     +      ' SMALL AS MAX[BETA(K),1/SCLB(K)]*10**(-NETA/2), AND/OR   '/
     +      ' OF DELTA(I,J), I=1,N AND J=1,M, AS SMALL AS             '/
     +      ' MAX[DELTA(I,J),1/SCLD(I,J)]*10**(-NETA/2), WHERE NETA   '/
     +      ' IS DEFINED TO BE THE NUMBER OF RELIABLE DIGITS IN       '/
     +      ' PREDICTED VALUES (F) RETURNED FROM SUBROUTINE FUN,      '/
     +      ' PREVENT SUBROUTINE FUN FROM BEING PROPERLY EVALUATED.   '/
     +      ' THE INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW PROPER  '/
     +      ' EVALUATION OF SUBROUTINE FUN DURING THESE COMPUTATIONS  '/
     +      ' BEFORE THE REGRESSION PROCEDURE CAN CONTINUE.')
 1400 FORMAT
     +   (//' VARIABLE ISTOPJ HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE JAC WHEN INVOKED USING THE'/
     +      ' INITIAL ESTIMATES OF BETA AND DELTA SUPPLIED BY THE     '/
     +      ' USER.  THE INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW  '/
     +      ' PROPER EVALUATION OF SUBROUTINE JAC BEFORE THE          '/
     +      ' REGRESSION PROCEDURE CAN CONTINUE.')
      END
*DODPER
      SUBROUTINE DODPER
     +   (INFO,LUNERR,SHORT,
     +   N,NP,M,
     +   LDSCLD,LDWD,
     +   LWKMN,LIWKMN,
     +   SCLD,SCLB,W,WD,
     +   MSGB,ISODR,MSGX,
     +   XPLUSD,LDXPD,NROW,NETA,NTOL)
C***BEGIN PROLOGUE  DODPER
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DODPE1,DODPE2,DODPE3,DODPHD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CONTROLLING ROUTINE FOR PRINTING ERROR REPORTS.
C***END PROLOGUE  DODPER
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,LDSCLD,LDWD,LDXPD,LIWKMN,LUNERR,LWKMN,M,N,NETA,NP,
     +   NROW,NTOL
      LOGICAL
     +   ISODR,SHORT
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   SCLB(NP),SCLD(LDSCLD,M),W(N),WD(LDWD,M),XPLUSD(LDXPD,M)
      INTEGER
     +   MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      INTEGER
     +   D1,D2,D3,D4,D5,UNIT
      LOGICAL
     +   HEAD
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DODPE1,DODPE2,DODPE3,DODPHD
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER D1
C        THE FIRST DIGIT OF INFO.
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER D4
C        THE FOURTH DIGIT OF INFO.
C     INTEGER D5
C        THE FIFTH DIGIT OF INFO.
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF RELIABLE DIGITS IN THE MODEL.
C     DOUBLE PRECISION SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        FINITE DIFFERENCE AND THE USER-SUPPLIED DERIVATIVES.
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPER
*
*
C  SET LOGICAL UNIT NUMBER FOR ERROR REPORT
*
      IF (LUNERR.EQ.0) THEN
         RETURN
      ELSE IF (LUNERR.LT.0) THEN
         UNIT = 6
      ELSE
         UNIT = LUNERR
      END IF
*
C  PRINT HEADING
*
      HEAD = .TRUE.
      CALL DODPHD(HEAD,UNIT)
*
C  EXTRACT INDIVIDUAL DIGITS FROM VARIABLE INFO
*
      D1 = MOD(INFO,100000)/10000
      D2 = MOD(INFO,10000)/1000
      D3 = MOD(INFO,1000)/100
      D4 = MOD(INFO,100)/10
      D5 = MOD(INFO,10)
*
C  PRINT APPROPRIATE ERROR MESSAGES FOR ODRPACK INVOKED STOP
*
      IF (D1.GE.1 .AND. D1.LE.3) THEN
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN
C     PROBLEM SPECIFICATION PARAMETERS
C     DIMENSION SPECIFICATION PARAMETERS
C     NUMBER OF GOOD DIGITS IN X
C     OBSERVATIONAL ERROR WEIGHTS
C     DELTA WEIGHTS
*
         CALL DODPE1(UNIT,D1,D2,D3,D4,D5,
     +               N,
     +               LDSCLD,LDWD,
     +               LWKMN,LIWKMN)
*
      ELSE IF (D1.EQ.4) THEN
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS DETECTED IN THE USER-SUPPLIED
C  JACOBIAN
*
         CALL DODPE2(UNIT,
     +                NP,M,
     +                MSGB,ISODR,MSGX,
     +                XPLUSD,LDXPD,NROW,NETA,NTOL)
*
      ELSE IF (D1.EQ.5) THEN
*
C  PRINT APPROPRIATE ERROR MESSAGE FOR USER INVOKED STOP FROM FUN OR JAC
*
         CALL DODPE3(UNIT,D2,D3)
*
      END IF
*
C  PRINT CORRECT FORM OF CALL STATEMENT
*
      IF ((D1.GE.1 .AND. D1.LE.3) .OR.
     +    (D1.EQ.4 .AND. (D2.EQ.2 .OR. D3.EQ.2)) .OR.
     +    (D1.EQ.5)) THEN
         IF (SHORT) THEN
            WRITE (UNIT,1100)
         ELSE
            WRITE (UNIT,1200)
         END IF
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1100 FORMAT
     +   (//' THE CORRECT FORM OF THE CALL STATEMENT IS '//
     +      '       CALL DODR'/
     +      '      +     (FUN,JAC,'/
     +      '      +     N,M,NP,'/
     +      '      +     X,LDX,'/
     +      '      +     Y,'/
     +      '      +     BETA,'/
     +      '      +     WD,LDWD,'/
     +      '      +     JOB,'/
     +      '      +     IPRINT,LUNERR,LUNRPT,'/
     +      '      +     WORK,LWORK,IWORK,LIWORK,'/
     +      '      +     INFO)')
 1200 FORMAT
     +   (//' THE CORRECT FORM OF THE CALL STATEMENT IS '//
     +      '       CALL DODRC'/
     +      '      +     (FUN,JAC,'/
     +      '      +     N,M,NP,'/
     +      '      +     X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,'/
     +      '      +     Y,'/
     +      '      +     BETA,IFIXB,SCLB,'/
     +      '      +     WD,LDWD,W,'/
     +      '      +     JOB,NDIGIT,TAUFAC,'/
     +      '      +     SSTOL,PARTOL,MAXIT,'/
     +      '      +     IPRINT,LUNERR,LUNRPT,'/
     +      '      +     WORK,LWORK,IWORK,LIWORK,'/
     +      '      +     INFO)')
*
      END
*DODPHD
      SUBROUTINE DODPHD
     +   (HEAD,UNIT)
C***BEGIN PROLOGUE  DODPHD
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PRINT ODRPACK HEADING
C***END PROLOGUE  DODPHD
*
C...SCALAR ARGUMENTS
      INTEGER
     +   UNIT
      LOGICAL
     +   HEAD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER TO WHICH THE HEADING IS WRITTEN.
*
*
C***FIRST EXECUTABLE STATEMENT  DODPHD
*
*
      IF (HEAD) THEN
         WRITE(UNIT,1000)
         HEAD = .FALSE.
      END IF
*
      RETURN
*
C   FORMAT STATEMENTS
*
 1000 FORMAT (///
     +   ' ******************************************************* '/
     +   ' * ODRPACK VERSION 1.71 OF 07-27-89 (DOUBLE PRECISION) * '/
     +   ' ******************************************************* '/)
      END
*DODR
      SUBROUTINE DODR
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,
     +   Y,
     +   BETA,
     +   WD,LDWD,
     +   JOB,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
C***BEGIN PROLOGUE  DODR
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  USER-CALLABLE DOUBLE PRECISION CONTROL ROUTINE FOR FINDING
C            THE WEIGHTED ORTHOGONAL DISTANCE REGRESSION (ODR) OR
C            ORDINARY LINEAR OR NONLINEAR LEAST SQUARES (OLS) SOLUTION
C            (SHORT CALL STATEMENT)
C***DESCRIPTION
C      REFERENCE FOR ONLINE DOCUMENTATION IS GIVEN BELOW.
C      THE ONLINE DOCUMENTATION CAN BE INSERTED HERE IF REQUIRED BY
C      YOUR DOCUMENTATION RETRIEVAL SYSTEM.  ONLINE DOCUMENTATION DOES
C      NOT EXTEND BEYOND COLUMN 80, AND COLUMN 1 OF ONLINE
C      DOCUMENTATION CAN BE CHANGED TO 'C' WITHOUT LOSS OF INFORMATION.
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  DODDRV
C***END PROLOGUE  DODR
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,JOB,LDWD,LDX,LIWORK,LWORK,M,N,NDIGIT,NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),WD(LDWD,M),WORK(LWORK),X(LDX,M),Y(N)
      INTEGER
     +   IWORK(LIWORK)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   NEGONE,PARTOL,SSTOL,TAUFAC
      INTEGER
     +   IPRINT,LDIFX,LDSCLD,LUNERR,LUNRPT,MAXIT
      LOGICAL
     +   SHORT
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   SCLB(1),SCLD(1,1),W(1)
      INTEGER
     +   IFIXB(1),IFIXX(1,1)
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DODDRV
*
C...DATA STATEMENTS
      DATA
     +   NEGONE
     +   /-1.0D0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXB(1)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(1,1)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION NEGONE
C        THE VALUE -1.0D0.
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLB(1)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(1,1)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION W(1)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WORK(LWORK)
C        THE DOUBLE PRECISION WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  DODR
*
*
C  INITIALIZE NECESSARY VARIABLES TO INDICATE USE OF DEFAULT VALUES
*
      IFIXX(1,1) = -1
      LDIFX = 1
      SCLD(1,1) = NEGONE
      LDSCLD = 1
      IFIXB(1) = -1
      SCLB(1) = NEGONE
      W(1) = NEGONE
      TAUFAC = NEGONE
      SSTOL = NEGONE
      PARTOL = NEGONE
      MAXIT = -1
      NDIGIT = -1
*
      SHORT = .TRUE.
*
      CALL DODDRV
     +     (SHORT,
     +     FUN,JAC,
     +     N,M,NP,
     +     X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +     Y,
     +     BETA,IFIXB,SCLB,
     +     WD,LDWD,W,
     +     JOB,NDIGIT,TAUFAC,
     +     SSTOL,PARTOL,MAXIT,
     +     IPRINT,LUNERR,LUNRPT,
     +     WORK,LWORK,IWORK,LIWORK,
     +     INFO)
*
      RETURN
*
      END
*DODRC
      SUBROUTINE DODRC
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   Y,
     +   BETA,IFIXB,SCLB,
     +   WD,LDWD,W,
     +   JOB,NDIGIT,TAUFAC,
     +   SSTOL,PARTOL,MAXIT,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
C***BEGIN PROLOGUE  DODRC
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  USER-CALLABLE DOUBLE PRECISION CONTROL ROUTINE FOR FINDING
C            THE WEIGHTED ORTHOGONAL DISTANCE REGRESSION (ODR) OR
C            ORDINARY LINEAR OR NONLINEAR LEAST SQUARES (OLS) SOLUTION
C            (LONG CALL STATEMENT)
C***DESCRIPTION
C      REFERENCE FOR ONLINE DOCUMENTATION IS GIVEN BELOW.
C      THE ONLINE DOCUMENTATION CAN BE INSERTED HERE IF REQUIRED BY
C      YOUR DOCUMENTATION RETRIEVAL SYSTEM.  ONLINE DOCUMENTATION DOES
C      NOT EXTEND BEYOND COLUMN 80, AND COLUMN 1 OF ONLINE
C      DOCUMENTATION CAN BE CHANGED TO 'C' WITHOUT LOSS OF INFORMATION.
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  DODDRV
C***END PROLOGUE  DODRC
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   INFO,IPRINT,JOB,LDIFX,LDSCLD,LDWD,LDX,LIWORK,LUNERR,
     +   LUNRPT,LWORK,M,MAXIT,N,NDIGIT,NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),SCLB(NP),SCLD(LDSCLD,M),
     +   W(N),WD(LDWD,M),WORK(LWORK),X(LDX,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),IWORK(LIWORK)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      LOGICAL
     +   SHORT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DODDRV
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     DOUBLE PRECISION SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WORK(LWORK)
C        THE DOUBLE PRECISION WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  DODRC
*
*
      SHORT = .FALSE.
*
      CALL DODDRV
     +     (SHORT,
     +     FUN,JAC,
     +     N,M,NP,
     +     X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +     Y,
     +     BETA,IFIXB,SCLB,
     +     WD,LDWD,W,
     +     JOB,NDIGIT,TAUFAC,
     +     SSTOL,PARTOL,MAXIT,
     +     IPRINT,LUNERR,LUNRPT,
     +     WORK,LWORK,IWORK,LIWORK,
     +     INFO)
*
      RETURN
*
      END
*DODSTP
      SUBROUTINE DODSTP
     +   (N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +   W,WD,LDWD,SS,TT,LDTT,DDELT,
     +   ALPHA,EPSMAC,
     +   SSS,TFJACB,VDTD,OMEGA,YT,U,QRAUX,WRK2,JPVT,
     +   S,T,PHI,IRANK,
     +   RCOND)
C***BEGIN PROLOGUE  DODSTP
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  IDAMAX,DCHEX,DDIAGS,DDOT,DIDTS,DNRM2,DQRDC,
C                    DQRSL,DROT,DROTG,DTRCO,DTRSL,DZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE LOCALLY CONSTRAINED STEPS S AND T, AND PHI(ALPHA)
C***END PROLOGUE  DODSTP
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   ALPHA,EPSMAC,PHI,RCOND
      INTEGER
     +   IRANK,LDFJB,LDFJX,LDTT,LDWD,M,N,NP,NPP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DDELT(N,M),F(N),FJACB(LDFJB,NP),FJACX(LDFJX,M),
     +   OMEGA(N),QRAUX(NP),S(NP),SS(NP),
     +   SSS(N+N*M),T(N,M),TFJACB(N,NP),TT(LDTT,M),U(N),
     +   VDTD(N,M),W(N),WD(LDWD,M),WRK2(NP),YT(N)
      INTEGER
     +   JPVT(NP)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   CO,ONE,SI,TEMP,ZERO
      INTEGER
     +   I,IMAX,INF,IPVT,J,KP
      LOGICAL
     +   ELIM
*
C...LOCAL ARRAYS
      DOUBLE PRECISION
     +   DUM(1)
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DDOT,DNRM2
      INTEGER
     +   IDAMAX
      EXTERNAL
     +   DDOT,DNRM2,IDAMAX
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DCHEX,DDIAGS,DIDTS,DQRDC,DQRSL,DROT,DROTG,DTRCO,DTRSL,
     +   DZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0D0,1.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     DOUBLE PRECISION CO
C        THE COSINE FROM THE PLANE ROTATION.
C     DOUBLE PRECISION DDELT(N,M)
C        THE ARRAY (W*D)**2 * DELTA.
C     DOUBLE PRECISION DUM
C        AN DUMMY VARIABLE.
C     LOGICAL ELIM
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER COLUMNS OF THE
C        JACOBIAN WRT BETA HAVE BEEN ELIMINATED (ELIM=.TRUE.) OR NOT
C        (ELIM=.FALSE.).
C     DOUBLE PRECISION EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     DOUBLE PRECISION F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     DOUBLE PRECISION FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     DOUBLE PRECISION FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IMAX
C        THE INDEX OF THE ELEMENT OF U HAVING THE LARGEST ABSOLUTE
C        VALUE.
C     INTEGER INF
C        THE RETURN CODE FROM DQRSL AND DTRSL.
C     INTEGER IPVT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER OR NOT
C        PIVOTING IS TO BE DONE.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JPVT(NP)
C        THE PIVOT VECTOR.
C     INTEGER KP
C        THE RANK OF THE JACOBIAN WRT BETA.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     DOUBLE PRECISION OMEGA(N)
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION PHI
C        THE DIFFERENCE BETWEEN THE NORM OF THE SCALED STEP
C        AND THE TRUST REGION DIAMETER.
C     DOUBLE PRECISION QRAUX(NP)
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     DOUBLE PRECISION RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     DOUBLE PRECISION S(NP)
C        THE STEP FOR THE ESTIMATED BETA'S.
C     DOUBLE PRECISION SI
C        THE SINE FROM THE PLANE ROTATION.
C     DOUBLE PRECISION SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION SSS(N+N*M)
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     DOUBLE PRECISION T(N,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     DOUBLE PRECISION TEMP
C        A TEMPORARY STORAGE LOCATION.
C     DOUBLE PRECISION TFJACB(N,NP)
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION U(N)
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     DOUBLE PRECISION VDTD(N,M)
C        THE ARRAY DDELT*INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WRK2(NP)
C        A WRK2 ARRAY.
C     DOUBLE PRECISION YT(N)
C         THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DODSTP
*
*
C  COMPUTE LOOP PARAMETERS WHICH DEPEND ON WEIGHT STRUCTURE
*
C  SET UP JPVT IF ALPHA = 0
*
      IF (ALPHA.EQ.ZERO) THEN
         KP = NPP
         DO 10 I=1,NPP
            JPVT(I) = I
   10    CONTINUE
      ELSE
         IF (NPP.GE.1) THEN
            KP = NPP-IRANK
         ELSE
            KP = NPP
         END IF
      END IF
*
C  SET UP OMEGA AND TFJACB
C  (VDTD = FJACX * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2)
*
      CALL DIDTS(N,M,W,WD,LDWD,ALPHA,TT,LDTT,FJACX,LDFJX,VDTD,N)
      DO 20 I=1,N
         OMEGA(I) = SQRT(ONE+DDOT(M,VDTD(I,1),N,FJACX(I,1),LDFJX))
   20 CONTINUE
      DO 40 J=1,KP
         DO 30 I=1,N
            TFJACB(I,J) = FJACB(I,JPVT(J))/OMEGA(I)
   30    CONTINUE
   40 CONTINUE
*
C  SET UP VDTD AND YT
C  (VDTD = DDELT * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2)
*
      CALL DIDTS(N,M,W,WD,LDWD,ALPHA,TT,LDTT,DDELT,N,VDTD,N)
      DO 50 I=1,N
         VDTD(I,1) = DDOT(M,FJACX(I,1),LDFJX,VDTD(I,1),N)
         YT(I) = -(F(I)-VDTD(I,1))/OMEGA(I)
   50 CONTINUE
*
C  COMPUTE S
*
C  DO QR FACTORIZATION (WITH COLUMN PIVOTING OF TRJACB IF ALPHA = 0)
*
      IF (ALPHA.EQ.ZERO) THEN
         IPVT = 1
         DO 60 I=1,NPP
            JPVT(I) = 0
   60    CONTINUE
      ELSE
         IPVT = 0
      END IF
*
      CALL DQRDC(TFJACB,N,N,KP,QRAUX,JPVT,WRK2,IPVT)
*
C     GET TR(Q)*YT
*
      CALL DQRSL(TFJACB,N,N,KP,QRAUX,YT,DUM,YT,DUM,DUM,DUM,1000,INF)
*
C  ELIMINATE ALPHA PART USING GIVENS ROTATIONS
*
      IF (ALPHA.NE.ZERO) THEN
         CALL DZERO(NPP,1,S,NPP)
         DO 90 I=1,KP
            CALL DZERO(KP,1,WRK2,KP)
            IF (SS(1).GT.ZERO) THEN
               WRK2(I) = SQRT(ALPHA)*SS(JPVT(I))
            ELSE
               WRK2(I) = SQRT(ALPHA)*ABS(SS(1))
            END IF
            DO 80 J=I,KP
               CALL DROTG(TFJACB(J,J),WRK2(J),CO,SI)
               IF (KP-J.GE.1) THEN
                  CALL DROT(KP-J,TFJACB(J,J+1),N,WRK2(J+1),1,CO,SI)
               END IF
               TEMP = CO*YT(J) + SI*S(JPVT(I))
               S(JPVT(I)) = -SI*YT(J) + CO*S(JPVT(I))
               YT(J) = TEMP
   80       CONTINUE
   90    CONTINUE
      END IF
*
C  COMPUTE SOLUTION - ELIMINATE VARIABLES IF NECESSARY
*
      IF (NPP.GE.1) THEN
         IF (ALPHA.EQ.ZERO) THEN
            KP = NPP
*
C  ESTIMATE RCOND - U WILL CONTAIN APPROX NULL VECTOR
*
  100       CALL DTRCO(TFJACB,N,KP,RCOND,U,1)
            IF (RCOND.LE.EPSMAC) THEN
               ELIM = .TRUE.
               IMAX = IDAMAX(KP,U,1)
*
C IMAX IS THE COLUMN TO REMOVE - USE DCHEX AND FIX JPVT
*
               IF (IMAX.NE.KP) THEN
                  CALL DCHEX(TFJACB,N,KP,IMAX,KP,YT,N,1,QRAUX,WRK2,2)
                  J = JPVT(IMAX)
                  DO 110 I=IMAX,KP-1
                     JPVT(I) = JPVT(I+1)
  110             CONTINUE
                  JPVT(KP) = J
               END IF
               KP = KP-1
            ELSE
               ELIM = .FALSE.
            END IF
            IF (ELIM .AND. KP.GE.1) THEN
               GO TO 100
            ELSE
               IRANK = NPP-KP
            END IF
         END IF
*
C  BACKSOLVE AND UNSCRAMBLE
*
         DO 120 I=KP+1,NPP
            YT(I) = ZERO
  120    CONTINUE
         IF (KP.GE.1) THEN
            CALL DTRSL(TFJACB,N,KP,YT,01,INF)
         END IF
         DO 130 I=1,NPP
            S(JPVT(I)) = YT(I)
  130    CONTINUE
      END IF
*
C  COMPUTE T
*
      DO 140 I=1,N
         TEMP = F(I)+DDOT(NPP,FJACB(I,1),LDFJB,S,1)
         U(I) = (TEMP-VDTD(I,1))/(OMEGA(I)**2)
  140 CONTINUE
      DO 160 J=1,M
         DO 150 I=1,N
            T(I,J) = -(FJACX(I,J)*U(I) + DDELT(I,J))
  150    CONTINUE
  160 CONTINUE
*
C  (T = T * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2)
*
      CALL DIDTS(N,M,W,WD,LDWD,ALPHA,TT,LDTT,T,N,T,N)
*
C  COMPUTE PHI(ALPHA) FROM SCALED S AND T
*
      IF (NPP.GE.1) THEN
         CALL DDIAGS(NPP,1,SS,NPP,S,NPP,SSS,NPP)
      END IF
      CALL DDIAGS(N,M,TT,LDTT,T,N,SSS(NPP+1),N)
      PHI = DNRM2(NPP+N*M,SSS,1)
*
      RETURN
      END
*DPACK
      SUBROUTINE DPACK
     +   (N2,N1,V1,V2,IFIX)
C***BEGIN PROLOGUE  DPACK
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DCOPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SELECT THE UNFIXED ELEMENTS OF V2 AND RETURN THEM IN V1
C***END PROLOGUE  DPACK
*
C...SCALAR ARGUMENTS
      INTEGER
     +   N1,N2
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   V1(N2),V2(N2)
      INTEGER
     +   IFIX(N2)
*
C...LOCAL SCALARS
      INTEGER
     +   I
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DCOPY
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIX(N2)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF V2 ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE DISCUSSION OF IFIXB AND IFIXX IN PROLOGUE OF
C        SUBROUTINE DODR OR DODRC.)
C     INTEGER N1
C        THE NUMBER OF ITEMS IN V1.
C     INTEGER N2
C        THE NUMBER OF ITEMS IN V2.
C     DOUBLE PRECISION V1(N2)
C        THE VECTOR OF THE UNFIXED ITEMS FROM V2.
C     DOUBLE PRECISION V2(N2)
C        THE VECTOR OF THE FIXED AND UNFIXED ITEMS FROM WHICH THE
C        UNFIXED ELEMENTS ARE TO BE EXTRACTED.
*
*
C***FIRST EXECUTABLE STATEMENT  DPACK
*
*
      N1 = 0
      IF (IFIX(1).GE.0) THEN
         DO 10 I=1,N2
            IF (IFIX(I).NE.0) THEN
               N1 = N1+1
               V1(N1) = V2(I)
            END IF
   10    CONTINUE
      ELSE
         N1 = N2
         CALL DCOPY(N2,V2,1,V1,1)
      END IF
*
      RETURN
      END
*DPVB
      DOUBLE PRECISION FUNCTION DPVB
     +   (FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,NROW,J,STP,ISTOPF)
C***BEGIN PROLOGUE  DPVB
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE THE NROW-TH FUNCTION VALUE USING BETA(J) + STP
C***END PROLOGUE  DPVB
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   STP
      INTEGER
     +   ISTOPF,J,LDXPD,M,N,NFEV,NP,NROW
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   TEMP
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUE FROM THE MODEL.
C     DOUBLE PRECISION STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE.
C     DOUBLE PRECISION TEMP
C        A TEMPORARY LOCATION IN WHICH THE CURRENT ESTIMATE OF THE JTH
C        PARAMETER IS STORED.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  DPVB
*
*
C  COMPUTE PREDICTED VALUES
*
      TEMP = BETA(J)
      BETA(J) = BETA(J) + STP
      ISTOPF = 0
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,ISTOPF)
      NFEV = NFEV + 1
      BETA(J) = TEMP
*
      DPVB = PVTEMP(NROW)
*
      RETURN
      END
*DPVD
      DOUBLE PRECISION FUNCTION DPVD
     +   (FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,NROW,J,STP,ISTOPF)
C***BEGIN PROLOGUE  DPVD
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE NROW-TH FUNCTION VALUE USING
C            X(NROW,J) + DELTA(NROW,J) + STP
C***END PROLOGUE  DPVD
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   STP
      INTEGER
     +   ISTOPF,J,LDXPD,M,N,NFEV,NP,NROW
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   TEMP
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUE FROM THE MODEL.
C     DOUBLE PRECISION STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE.
C     DOUBLE PRECISION TEMP
C        A TEMPORARY LOCATION IN WHICH THE CURRENT ESTIMATE OF THE
C        (NROW,J)TH ELEMENT OF XPLUSD IS STORED.
C     DOUBLE PRECISION XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  DPVD
*
*
C  COMPUTE PREDICTED VALUES
*
      TEMP = XPLUSD(NROW,J)
      XPLUSD(NROW,J) = XPLUSD(NROW,J) + STP
      ISTOPF = 0
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,ISTOPF)
      NFEV = NFEV + 1
      XPLUSD(NROW,J) = TEMP
*
      DPVD = PVTEMP(NROW)
*
      RETURN
      END
*DSCLB
      SUBROUTINE DSCLB
     +   (NP,BETA,SSF)
C***BEGIN PROLOGUE  DSCLB
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE APPROPRIATE SCALE VALUES FOR BETA'S ACCORDING TO
C            THE ALGORITHM GIVEN IN THE PROLOGUES FOR DODR AND DODRC
C***END PROLOGUE  DSCLB
*
C...SCALAR ARGUMENTS
      INTEGER
     +   NP
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   BETA(NP),SSF(NP)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   BMAX,BMIN,ONE,TEN,ZERO
      INTEGER
     +   K
      LOGICAL
     +   BIGDIF
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,LOG10,MAX,MIN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TEN
     +   /0.0D0,1.0D0,10.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL BIGDIF
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THERE IS A
C        SIGNIFICANT DIFFERENCE IN THE MAGNITUDES OF THE NONZERO
C        BETA'S (BIGDIF=.TRUE.) OR NOT (BIGDIF=.FALSE.).
C     DOUBLE PRECISION BMAX
C        THE LARGEST NONZERO MAGNITUDE.
C     DOUBLE PRECISION BMIN
C        THE SMALLEST NONZERO MAGNITUDE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION TEN
C        THE VALUE 10.0D0.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DSCLB
*
*
      BMAX = ABS(BETA(1))
      DO 10 K=2,NP
         BMAX = MAX(BMAX,ABS(BETA(K)))
   10 CONTINUE
*
      IF (BMAX.EQ.ZERO) THEN
*
C  ALL INPUT VALUES OF BETA ARE ZERO
*
         DO 20 K=1,NP
            SSF(K) = ONE
   20    CONTINUE
*
      ELSE
*
C  SOME OF THE INPUT VALUES ARE NONZERO
*
         BMIN = BMAX
         DO 30 K=1,NP
            IF (BETA(K).NE.ZERO) THEN
               BMIN = MIN(BMIN,ABS(BETA(K)))
            END IF
   30    CONTINUE
         BIGDIF = LOG10(BMAX)-LOG10(BMIN).GE.ONE
         DO 40 K=1,NP
            IF (BETA(K).EQ.ZERO) THEN
               SSF(K) =  TEN/BMIN
            ELSE
               IF (BIGDIF) THEN
                  SSF(K) = ONE/ABS(BETA(K))
               ELSE
                  SSF(K) = ONE/BMAX
               END IF
            END IF
   40    CONTINUE
*
      END IF
*
      RETURN
      END
*DSCLD
      SUBROUTINE DSCLD
     +   (N,M,X,LDX,TT,LDTT)
C***BEGIN PROLOGUE  DSCLD
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE APPROPRIATE SCALE VALUES FOR DELTA'S ACCORDING TO
C            THE ALGORITHM GIVEN IN THE PROLOGUES FOR DODR AND DODRC
C***END PROLOGUE  DSCLD
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDTT,LDX,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   TT(LDTT,M),X(LDX,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ONE,TEN,XMAX,XMIN,ZERO
      INTEGER
     +   I,J
      LOGICAL
     +   BIGDIF
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,LOG10,MAX,MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TEN
     +   /0.0D0,1.0D0,10.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL BIGDIF
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THERE IS A
C        SIGNIFICANT DIFFERENCE IN THE MAGNITUDES OF THE NONZERO
C        BETA'S (BIGDIF=.TRUE.) OR NOT (BIGDIF=.FALSE.).
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION ONE
C        THE VALUE 1.0D0.
C     DOUBLE PRECISION TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION XMAX
C        THE LARGEST NONZERO MAGNITUDE.
C     DOUBLE PRECISION XMIN
C        THE SMALLEST NONZERO MAGNITUDE.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DSCLD
*
*
      DO 50 J=1,M
         XMAX = ABS(X(1,J))
         DO 10 I=2,N
            XMAX = MAX(XMAX,ABS(X(I,J)))
   10    CONTINUE
*
         IF (XMAX.EQ.ZERO) THEN
*
C  ALL INPUT VALUES OF X(I,J), I=1,...,N, ARE ZERO
*
            DO 20 I=1,N
               TT(I,J) = ONE
   20       CONTINUE
*
         ELSE
*
C  SOME OF THE INPUT VALUES ARE NONZERO
*
            XMIN = XMAX
            DO 30 I=1,N
               IF (X(I,J).NE.ZERO) THEN
                  XMIN = MIN(XMIN,ABS(X(I,J)))
               END IF
   30       CONTINUE
            BIGDIF = LOG10(XMAX)-LOG10(XMIN).GE.ONE
            DO 40 I=1,N
               IF (X(I,J).NE.ZERO) THEN
                  IF (BIGDIF) THEN
                     TT(I,J) = ONE/ABS(X(I,J))
                  ELSE
                     TT(I,J) = ONE/XMAX
                  END IF
               ELSE
                  TT(I,J) = TEN/XMIN
               END IF
   40       CONTINUE
         END IF
   50 CONTINUE
*
      RETURN
      END
*DSETN
      SUBROUTINE DSETN
     +   (N,M,X,LDX,NROW)
C***BEGIN PROLOGUE  DSETN
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SELECT THE ROW AT WHICH THE DERIVATIVE WILL BE CHECKED
C***END PROLOGUE  DSETN
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDX,M,N,NROW
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   X(LDX,M)
*
C...LOCAL SCALARS
      INTEGER
     +   I,J
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEX VARIABLE.
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE USER-SUPPLIED NUMBER OF THE ROW OF THE INDEPENDENT
C        VARIABLE ARRAY AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     DOUBLE PRECISION X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  DSETN
*
*
      IF ((NROW.GE.1) .AND. (NROW.LE.N)) RETURN
*
C     SELECT FIRST ROW OF INDEPENDENT VARIABLES WHICH CONTAINS NO ZEROS
C     IF THERE IS ONE, OTHERWISE FIRST ROW IS USED.
*
      DO 20 I = 1, N
         DO 10 J = 1, M
            IF (X(I,J).EQ.0.0) GO TO 20
   10    CONTINUE
         NROW = I
         RETURN
   20 CONTINUE
*
      NROW = 1
*
      RETURN
      END
*DUNPAC
      SUBROUTINE DUNPAC
     +   (N2,V1,V2,IFIX)
C***BEGIN PROLOGUE  DUNPAC
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  DCOPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COPY THE ELEMENTS OF V1 INTO THE LOCATIONS OF V2 WHICH ARE
C            UNFIXED
C***END PROLOGUE  DUNPAC
*
C...SCALAR ARGUMENTS
      INTEGER
     +   N2
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   V1(N2),V2(N2)
      INTEGER
     +   IFIX(N2)
*
C...LOCAL SCALARS
      INTEGER
     +   I,N1
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DCOPY
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIX(N2)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF V2 ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE DISCUSSION OF IFIXB AND IFIXX IN PROLOGUE OF
C        SUBROUTINE DODR OR DODRC.)
C     INTEGER N1
C        THE NUMBER OF ITEMS IN V1.
C     INTEGER N2
C        THE NUMBER OF ITEMS IN V2.
C     DOUBLE PRECISION V1(N2)
C        THE VECTOR OF THE UNFIXED ITEMS.
C     DOUBLE PRECISION V2(N2)
C        THE VECTOR OF THE FIXED AND UNFIXED ITEMS INTO WHICH THE
C        ELEMENTS OF V1 ARE TO BE INSERTED.
*
*
C***FIRST EXECUTABLE STATEMENT  DUNPAC
*
*
      N1 = 0
      IF (IFIX(1).GE.0) THEN
         DO 10 I = 1,N2
            IF (IFIX(I).NE.0) THEN
               N1 = N1 + 1
               V2(I) = V1(N1)
            END IF
   10    CONTINUE
      ELSE
         N1 = N2
         CALL DCOPY(N2,V1,1,V2,1)
      END IF
*
      RETURN
      END
*DWDS
      SUBROUTINE DWDS
     +   (N,M,W,WD,LDWD,T,LDT,WDT,LDWDT)
C***BEGIN PROLOGUE  DWDS
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE MATRIX T USING W*D, I.E., COMPUTE
C            WDT = W*D*T
C            WHERE W AND D ARE DEFINED BY EQ.2 OF THE PROLOGUES FOR
C            DODR AND DODRC
C***END PROLOGUE  DWDS
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDT,LDWD,LDWDT,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   T(LDT,M),W(N),WD(LDWD,M),WDT(LDWDT,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   TEMP,ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDT
C        THE LEADING DIMENSION OF ARRAY T.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWDT
C        THE LEADING DIMENSION OF ARRAY WDT.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION T(LDT,M)
C        THE ARRAY BEING SCALED BY W*D.
C     DOUBLE PRECISION TEMP
C        A TEMPORARY STORAGE LOCATION.
C     DOUBLE PRECISION W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     DOUBLE PRECISION WDT(LDWDT,M)
C        THE RESULTS OF SCALING ARRAY T BY W*D.
C     DOUBLE PRECISION ZERO
C          THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DWDS
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (W(1).GE.ZERO) THEN
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               DO 20 J=1,M
                  DO 10 I=1,N
                     WDT(I,J) = W(I)*WD(I,J)*T(I,J)
   10             CONTINUE
   20          CONTINUE
            ELSE
               DO 40 J=1,M
                  DO 30 I=1,N
                     WDT(I,J) = W(I)*WD(1,J)*T(I,J)
   30             CONTINUE
   40          CONTINUE
            END IF
         ELSE
            DO 60 J=1,M
               DO 50 I=1,N
                  WDT(I,J) = W(I)*ABS(WD(1,1))*T(I,J)
   50          CONTINUE
   60       CONTINUE
         END IF
      ELSE
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               DO 80 J=1,M
                  DO 70 I=1,N
                     WDT(I,J) = WD(I,J)*T(I,J)
   70             CONTINUE
   80          CONTINUE
            ELSE
               DO 100 J=1,M
                  TEMP = WD(1,J)
                  DO 90 I=1,N
                     WDT(I,J) = TEMP*T(I,J)
   90             CONTINUE
  100          CONTINUE
            END IF
         ELSE
            TEMP = ABS(WD(1,1))
            DO 120 J=1,M
               DO 110 I=1,N
                  WDT(I,J) = TEMP*T(I,J)
  110          CONTINUE
  120       CONTINUE
         END IF
      END IF
*
      RETURN
      END
*DWINF
      SUBROUTINE DWINF
     +   (N,M,NP,
     +   DELTAI,EPSI,
     +   WSSI,WSSDEI,WSSEPI,RVARI,
     +   PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +   FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +   DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +   ALPHAI,VCVI,OMEGAI,YTI,UI,QRAUXI,WRK1I,SEI,RCONDI,
     +   ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +   LWKMN)
C***BEGIN PROLOGUE  DWINF
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET STORAGE LOCATIONS WITHIN DOUBLE PRECISION WORK SPACE
C***END PROLOGUE  DWINF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSI,EPSMAI,ETAI,FJACBI,FJACXI,FNI,FSI,LWKMN,M,N,NP,OLMAVI,
     +   OMEGAI,PARTLI,PNORMI,PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,SEI,SI,
     +   SSFI,SSI,SSSI,SSTOLI,TAUFCI,TAUI,TI,TTI,UI,VCVI,WRK1I,
     +   WSSI,WSSDEI,WSSEPI,XPLUSI,YTI
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER EPSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE.
C     INTEGER SEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STANDARD ERRORS FOR THE PARAMETERS, ALSO USED AS A
C        WORK ARRAY.
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER VCVI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE VARIANCE COVARIANCE MATRIX, ALSO USED
C        TO STORE THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     INTEGER YTI
C         THE STARTING LOCATION IN WORK OF
C         THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
*
*
C***FIRST EXECUTABLE STATEMENT  DWINF
*
*
      IF (N.GE.1 .AND. NP.GE.1 .AND. M.GE.1) THEN
         DELTAI =          1
         EPSI   = DELTAI + N*M
         WSSI   = EPSI   + N
         WSSDEI = WSSI   + 1
         WSSEPI = WSSDEI + 1
         RVARI  = WSSEPI + 1
         PARTLI = RVARI  + 1
         SSTOLI = PARTLI + 1
         TAUFCI = SSTOLI + 1
         EPSMAI = TAUFCI + 1
         OLMAVI = EPSMAI + 1
         FJACBI = OLMAVI + 1
         FJACXI = FJACBI + N*NP
         XPLUSI = FJACXI + N*M
         BETACI = XPLUSI + N*M
         BETASI = BETACI + NP
         BETANI = BETASI + NP
         DELTSI = BETANI + NP
         DELTNI = DELTSI + N*M
         DDELTI = DELTNI + N*M
         FSI    = DDELTI + N*M
         FNI    = FSI    + N
         SI     = FNI    + N
         SSSI   = SI     + NP
         SSI    = SSSI   + N*M + N
         SSFI   = SSI    + NP
         TI     = SSFI   + NP
         TTI    = TI     + N*M
         TAUI   = TTI    + N*M
         ALPHAI = TAUI   + 1
         VCVI   = ALPHAI + 1
         OMEGAI = VCVI   + N*NP
         YTI    = OMEGAI + N
         UI     = YTI    + N
         QRAUXI = UI     + N
         WRK1I  = QRAUXI + NP
         SEI    = WRK1I  + N*M
         RCONDI = SEI    + NP
         ETAI   = RCONDI + 1
         ACTRSI = ETAI   + 1
         PNORMI = ACTRSI + 1
         PRERSI = PNORMI + 1
         RNORSI = PRERSI + 1
         LWKMN  = RNORSI
      ELSE
         DELTAI = 1
         EPSI   = 1
         WSSI   = 1
         WSSDEI = 1
         WSSEPI = 1
         RVARI  = 1
         PARTLI = 1
         SSTOLI = 1
         TAUFCI = 1
         EPSMAI = 1
         OLMAVI = 1
         FJACBI = 1
         FJACXI = 1
         XPLUSI = 1
         BETACI = 1
         BETASI = 1
         BETANI = 1
         DELTSI = 1
         DELTNI = 1
         DDELTI = 1
         FSI    = 1
         FNI    = 1
         SI     = 1
         SSSI   = 1
         SSI    = 1
         SSFI   = 1
         TI     = 1
         TTI    = 1
         TAUI   = 1
         ALPHAI = 1
         VCVI   = 1
         OMEGAI = 1
         YTI    = 1
         UI     = 1
         QRAUXI = 1
         WRK1I  = 1
         SEI    = 1
         RCONDI = 1
         ETAI   = 1
         ACTRSI = 1
         PNORMI = 1
         PRERSI = 1
         RNORSI = 1
         LWKMN  = 1
      END IF
*
      RETURN
      END
*DXPY
      SUBROUTINE DXPY
     +   (N,M,X,LDX,Y,LDY,XPY,LDXPY)
C***BEGIN PROLOGUE  DXPY
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE XPY = X + Y
C***END PROLOGUE  DXPY
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDX,LDXPY,LDY,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   X(LDX,M),XPY(LDXPY,M),Y(LDY,M)
*
C...LOCAL SCALARS
      INTEGER
     +   I,J
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER LDXPY
C        THE LEADING DIMENSION OF ARRAY XPY.
C     INTEGER LDY
C        THE LEADING DIMENSION OF ARRAY Y.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN ARRAYS X AND Y TO BE ADDED
C        TOGETHER.
C     INTEGER N
C        THE NUMBER OF ROWS OF DATA IN ARRAYS X AND Y TO BE ADDED
C        TOGETHER.
C     DOUBLE PRECISION X(LDX,M)
C        THE FIRST OF THE TWO ARRAYS TO BE ADDED TOGETHER.
C     DOUBLE PRECISION XPY(LDXPY,M)
C        THE SUM OF THE TWO ARRAYS TO BE ADDED TOGETHER.
C     DOUBLE PRECISION Y(LDY,M)
C        THE SECOND OF THE TWO ARRAYS TO BE ADDED TOGETHER.
*
*
C***FIRST EXECUTABLE STATEMENT  DXPY
*
*
      DO 20 J=1,M
         DO 10 I=1,N
            XPY(I,J) = X(I,J) + Y(I,J)
   10    CONTINUE
   20 CONTINUE
*
      RETURN
      END
*DZERO
      SUBROUTINE DZERO
     +   (N,M,A,LDA)
C***BEGIN PROLOGUE  DZERO
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET A = ZERO
C***END PROLOGUE  DZERO
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDA,M,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   A(LDA,M)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ZERO
      INTEGER
     +   I,J
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0D0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     DOUBLE PRECISION A(LDA,M)
C        THE ARRAY TO BE SET TO ZERO.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDA
C        THE LEADING DIMENSION OF ARRAY A.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN ARRAY A TO BE SET TO ZERO.
C     INTEGER N
C        THE NUMBER OF ROWS OF DATA IN ARRAY A TO BE SET TO ZERO.
C     DOUBLE PRECISION ZERO
C        THE VALUE 0.0D0.
*
*
C***FIRST EXECUTABLE STATEMENT  DZERO
*
*
      DO 20 J=1,M
         DO 10 I=1,N
            A(I,J) = ZERO
   10    CONTINUE
   20 CONTINUE
*
      RETURN
      END
*JAC
      SUBROUTINE JAC(N,NP,M,BETA,XPLUSD,LDXPD,
     +               FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOP)
C***BEGIN PROLOGUE  JAC
C***REFER TO  ?CODR,?CODRC
C***ROUTINES CALLED  NONE
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  DUMMY ROUTINE PROVIDED TO PREVENT OCCURANCE OF
C            UNSATISFIED EXTERNAL WHEN THE USER DOES NOT PROVIDE
C            SUBROUTINE JAC.
C***END PROLOGUE  JAC
*
C...SCALAR ARGUMENTS
C     INTEGER
C    +   ISTOP,LDFJB,LDFJX,LDXPD,M,N,NP
C     LOGICAL
C    +   ISODR
*
C...ARRAY ARGUMENTS
C     FLOATING POINT
C    +   BETA(NP),FJACB(LDFJB,NP),FJACX(LDFJX,M),XPLUSD(LDXPD,M)
*
C...INTRINSIC FUNCTIONS
C     INTRINSIC
C    +   EXP
*
*
C***FIRST EXECUTABLE STATEMENT  JAC
*
*
      PRINT *, ' **** ERROR ****'
      PRINT *, ' USER IS ATTEMPTING TO ACCESS A SUBROUTINE JAC',
     +         ' WHEN NONE HAS BEEN PROVIDED'
*
      ISTOP = -1
*
      RETURN
      END
*DASUM
      DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
C***BEGIN PROLOGUE  DASUM
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A3A
C***KEYWORDS  ADD,BLAS,DOUBLE PRECISION,LINEAR ALGEBRA,MAGNITUDE,SUM,
C             VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  SUM OF MAGNITUDES OF D.P. VECTOR COMPONENTS
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C     --OUTPUT--
C    DASUM  DOUBLE PRECISION RESULT (ZERO IF N .LE. 0)
C     RETURNS SUM OF MAGNITUDES OF DOUBLE PRECISION DX.
C     DASUM = SUM FROM 0 TO N-1 OF DABS(DX(1+I*INCX))
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DASUM
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   DABS,MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DASUM
*
*
      DASUM = 0.D0
      IF(N.LE.0)RETURN
      IF(INCX.EQ.1)GOTO 20
*
C        CODE FOR INCREMENTS NOT EQUAL TO 1.
*
      NS = N*INCX
          DO 10 I=1,NS,INCX
          DASUM = DASUM + DABS(DX(I))
   10     CONTINUE
      RETURN
*
C        CODE FOR INCREMENTS EQUAL TO 1.
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 6.
*
   20 M = MOD(N,6)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
         DASUM = DASUM + DABS(DX(I))
   30 CONTINUE
      IF( N .LT. 6 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,6
         DASUM = DASUM + DABS(DX(I)) + DABS(DX(I+1)) + DABS(DX(I+2))
     1   + DABS(DX(I+3)) + DABS(DX(I+4)) + DABS(DX(I+5))
   50 CONTINUE
      RETURN
      END
*DAXPY
      SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
C***BEGIN PROLOGUE  DAXPY
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A7
C***KEYWORDS  BLAS,DOUBLE PRECISION,LINEAR ALGEBRA,TRIAD,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  D.P COMPUTATION Y = A*X + Y
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DA  DOUBLE PRECISION SCALAR MULTIPLIER
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C       DY  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF DY
C     --OUTPUT--
C       DY  DOUBLE PRECISION RESULT (UNCHANGED IF N .LE. 0)
C     OVERWRITE DOUBLE PRECISION DY WITH DOUBLE PRECISION DA*DX + DY.
C     FOR I = 0 TO N-1, REPLACE  DY(LY+I*INCY) WITH DA*DX(LX+I*INCX) +
C       DY(LY+I*INCY), WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N
C       AND LY IS DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DAXPY
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   DA
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*),DY(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DAXPY
*
*
      IF(N.LE.0.OR.DA.EQ.0.D0) RETURN
      IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60
    5 CONTINUE
*
C        CODE FOR NONEQUAL OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
        DY(IY) = DY(IY) + DA*DX(IX)
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C        CODE FOR BOTH INCREMENTS EQUAL TO 1
*
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 4.
*
   20 M = MOD(N,4)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        DY(I) = DY(I) + DA*DX(I)
   30 CONTINUE
      IF( N .LT. 4 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,4
        DY(I) = DY(I) + DA*DX(I)
        DY(I + 1) = DY(I + 1) + DA*DX(I + 1)
        DY(I + 2) = DY(I + 2) + DA*DX(I + 2)
        DY(I + 3) = DY(I + 3) + DA*DX(I + 3)
   50 CONTINUE
      RETURN
*
C        CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
*
   60 CONTINUE
      NS = N*INCX
          DO 70 I=1,NS,INCX
          DY(I) = DA*DX(I) + DY(I)
   70     CONTINUE
      RETURN
      END
*DCHEX
      SUBROUTINE DCHEX(R,LDR,P,K,L,Z,LDZ,NZ,C,S,JOB)
C***BEGIN PROLOGUE  DCHEX
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D7B
C***KEYWORDS  CHOLESKY DECOMPOSITION,DOUBLE PRECISION,EXCHANGE,
C             LINEAR ALGEBRA,LINPACK,MATRIX,POSITIVE DEFINITE
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  UPDATES THE CHOLESKY FACTORIZATION  A=TRANS(R)*R  OF A
C            POSITIVE DEFINITE MATRIX A OF ORDER P UNDER DIAGONAL
C            PERMUTATIONS OF THE FORM  TRANS(E)*A*E  WHERE E IS A
C            PERMUTATION MATRIX.
C***DESCRIPTION
C     DCHEX UPDATES THE CHOLESKY FACTORIZATION
C                   A = TRANS(R)*R
C     OF A POSITIVE DEFINITE MATRIX A OF ORDER P UNDER DIAGONAL
C     PERMUTATIONS OF THE FORM
C                   TRANS(E)*A*E
C     WHERE E IS A PERMUTATION MATRIX.  SPECIFICALLY, GIVEN
C     AN UPPER TRIANGULAR MATRIX R AND A PERMUTATION MATRIX
C     E (WHICH IS SPECIFIED BY K, L, AND JOB), DCHEX DETERMINES
C     AN ORTHOGONAL MATRIX U SUCH THAT
C                           U*R*E = RR,
C     WHERE RR IS UPPER TRIANGULAR.  AT THE USERS OPTION, THE
C     TRANSFORMATION U WILL BE MULTIPLIED INTO THE ARRAY Z.
C     IF A = TRANS(X)*X, SO THAT R IS THE TRIANGULAR PART OF THE
C     QR FACTORIZATION OF X, THEN RR IS THE TRIANGULAR PART OF THE
C     QR FACTORIZATION OF X*E, I.E. X WITH ITS COLUMNS PERMUTED.
C     FOR A LESS TERSE DESCRIPTION OF WHAT DCHEX DOES AND HOW
C     IT MAY BE APPLIED, SEE THE LINPACK GUIDE.
C     THE MATRIX Q IS DETERMINED AS THE PRODUCT U(L-K)*...*U(1)
C     OF PLANE ROTATIONS OF THE FORM
C                           (    C(I)       S(I) )
C                           (                    ) ,
C                           (    -S(I)      C(I) )
C     WHERE C(I) IS DOUBLE PRECISION.  THE ROWS THESE ROTATIONS OPERATE
C     ON ARE DESCRIBED BELOW.
C     THERE ARE TWO TYPES OF PERMUTATIONS, WHICH ARE DETERMINED
C     BY THE VALUE OF JOB.
C     1. RIGHT CIRCULAR SHIFT (JOB = 1).
C         THE COLUMNS ARE REARRANGED IN THE FOLLOWING ORDER.
C                1,...,K-1,L,K,K+1,...,L-1,L+1,...,P.
C         U IS THE PRODUCT OF L-K ROTATIONS U(I), WHERE U(I)
C         ACTS IN THE (L-I,L-I+1)-PLANE.
C     2. LEFT CIRCULAR SHIFT (JOB = 2).
C         THE COLUMNS ARE REARRANGED IN THE FOLLOWING ORDER
C                1,...,K-1,K+1,K+2,...,L,K,L+1,...,P.
C         U IS THE PRODUCT OF L-K ROTATIONS U(I), WHERE U(I)
C         ACTS IN THE (K+I-1,K+I)-PLANE.
C     ON ENTRY
C         R      DOUBLE PRECISION(LDR,P), WHERE LDR .GE. P.
C                R CONTAINS THE UPPER TRIANGULAR FACTOR
C                THAT IS TO BE UPDATED.  ELEMENTS OF R
C                BELOW THE DIAGONAL ARE NOT REFERENCED.
C         LDR    INTEGER.
C                LDR IS THE LEADING DIMENSION OF THE ARRAY R.
C         P      INTEGER.
C                P IS THE ORDER OF THE MATRIX R.
C         K      INTEGER.
C                K IS THE FIRST COLUMN TO BE PERMUTED.
C         L      INTEGER.
C                L IS THE LAST COLUMN TO BE PERMUTED.
C                L MUST BE STRICTLY GREATER THAN K.
C         Z      DOUBLE PRECISION(LDZ,N)Z), WHERE LDZ .GE. P.
C                Z IS AN ARRAY OF NZ P-VECTORS INTO WHICH THE
C                TRANSFORMATION U IS MULTIPLIED.  Z IS
C                NOT REFERENCED IF NZ = 0.
C         LDZ    INTEGER.
C                LDZ IS THE LEADING DIMENSION OF THE ARRAY Z.
C         NZ     INTEGER.
C                NZ IS THE NUMBER OF COLUMNS OF THE MATRIX Z.
C         JOB    INTEGER.
C                JOB DETERMINES THE TYPE OF PERMUTATION.
C                       JOB = 1  RIGHT CIRCULAR SHIFT.
C                       JOB = 2  LEFT CIRCULAR SHIFT.
C     ON RETURN
C         R      CONTAINS THE UPDATED FACTOR.
C         Z      CONTAINS THE UPDATED MATRIX Z.
C         C      DOUBLE PRECISION(P).
C                C CONTAINS THE COSINES OF THE TRANSFORMING ROTATIONS.
C         S      DOUBLE PRECISION(P).
C                S CONTAINS THE SINES OF THE TRANSFORMING ROTATIONS.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  DROTG
C***END PROLOGUE  DCHEX
*
C...SCALAR ARGUMENTS
      INTEGER
     +   JOB,K,L,LDR,LDZ,NZ,P
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   C(*),R(LDR,*),S(*),Z(LDZ,*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   T,T1
      INTEGER
     +   I,II,IL,IU,J,JJ,KM1,KP1,LM1,LMK
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DROTG
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MAX0,MIN0
*
*
C***FIRST EXECUTABLE STATEMENT  DCHEX
*
*
      KM1 = K - 1
      KP1 = K + 1
      LMK = L - K
      LM1 = L - 1
*
C     PERFORM THE APPROPRIATE TASK.
*
      GO TO (10,130), JOB
*
C     RIGHT CIRCULAR SHIFT.
*
   10 CONTINUE
*
C        REORDER THE COLUMNS.
*
         DO 20 I = 1, L
            II = L - I + 1
            S(I) = R(II,L)
   20    CONTINUE
         DO 40 JJ = K, LM1
            J = LM1 - JJ + K
            DO 30 I = 1, J
               R(I,J+1) = R(I,J)
   30       CONTINUE
            R(J+1,J+1) = 0.0D0
   40    CONTINUE
         IF (K .EQ. 1) GO TO 60
            DO 50 I = 1, KM1
               II = L - I + 1
               R(I,K) = S(II)
   50       CONTINUE
   60    CONTINUE
*
C        CALCULATE THE ROTATIONS.
*
         T = S(1)
         DO 70 I = 1, LMK
            T1 = S(I)
            CALL DROTG(S(I+1),T,C(I),T1)
            S(I) = T1
            T = S(I+1)
   70    CONTINUE
         R(K,K) = T
         DO 90 J = KP1, P
            IL = MAX0(1,L-J+1)
            DO 80 II = IL, LMK
               I = L - II
               T = C(II)*R(I,J) + S(II)*R(I+1,J)
               R(I+1,J) = C(II)*R(I+1,J) - S(II)*R(I,J)
               R(I,J) = T
   80       CONTINUE
   90    CONTINUE
*
C        IF REQUIRED, APPLY THE TRANSFORMATIONS TO Z.
*
         IF (NZ .LT. 1) GO TO 120
         DO 110 J = 1, NZ
            DO 100 II = 1, LMK
               I = L - II
               T = C(II)*Z(I,J) + S(II)*Z(I+1,J)
               Z(I+1,J) = C(II)*Z(I+1,J) - S(II)*Z(I,J)
               Z(I,J) = T
  100       CONTINUE
  110    CONTINUE
  120    CONTINUE
      GO TO 260
*
C     LEFT CIRCULAR SHIFT
*
  130 CONTINUE
*
C        REORDER THE COLUMNS
*
         DO 140 I = 1, K
            II = LMK + I
            S(II) = R(I,K)
  140    CONTINUE
         DO 160 J = K, LM1
            DO 150 I = 1, J
               R(I,J) = R(I,J+1)
  150       CONTINUE
            JJ = J - KM1
            S(JJ) = R(J+1,J+1)
  160    CONTINUE
         DO 170 I = 1, K
            II = LMK + I
            R(I,L) = S(II)
  170    CONTINUE
         DO 180 I = KP1, L
            R(I,L) = 0.0D0
  180    CONTINUE
*
C        REDUCTION LOOP.
*
         DO 220 J = K, P
            IF (J .EQ. K) GO TO 200
*
C              APPLY THE ROTATIONS.
*
               IU = MIN0(J-1,L-1)
               DO 190 I = K, IU
                  II = I - K + 1
                  T = C(II)*R(I,J) + S(II)*R(I+1,J)
                  R(I+1,J) = C(II)*R(I+1,J) - S(II)*R(I,J)
                  R(I,J) = T
  190          CONTINUE
  200       CONTINUE
            IF (J .GE. L) GO TO 210
               JJ = J - K + 1
               T = S(JJ)
               CALL DROTG(R(J,J),T,C(JJ),S(JJ))
  210       CONTINUE
  220    CONTINUE
*
C        APPLY THE ROTATIONS TO Z.
*
         IF (NZ .LT. 1) GO TO 250
         DO 240 J = 1, NZ
            DO 230 I = K, LM1
               II = I - KM1
               T = C(II)*Z(I,J) + S(II)*Z(I+1,J)
               Z(I+1,J) = C(II)*Z(I+1,J) - S(II)*Z(I,J)
               Z(I,J) = T
  230       CONTINUE
  240    CONTINUE
  250    CONTINUE
  260 CONTINUE
      RETURN
      END
*DCOPY
      SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
C***BEGIN PROLOGUE  DCOPY
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A5
C***KEYWORDS  BLAS,COPY,DOUBLE PRECISION,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  D.P. VECTOR COPY Y = X
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C       DY  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF DY
C     --OUTPUT--
C       DY  COPY OF VECTOR DX (UNCHANGED IF N .LE. 0)
C     COPY DOUBLE PRECISION DX TO DOUBLE PRECISION DY.
C     FOR I = 0 TO N-1, COPY DX(LX+I*INCX) TO DY(LY+I*INCY),
C     WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS
C     DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DCOPY
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*),DY(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DCOPY
*
*
      IF(N.LE.0)RETURN
      IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60
    5 CONTINUE
*
C        CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
        DY(IY) = DX(IX)
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C        CODE FOR BOTH INCREMENTS EQUAL TO 1
*
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 7.
*
   20 M = MOD(N,7)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        DY(I) = DX(I)
   30 CONTINUE
      IF( N .LT. 7 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,7
        DY(I) = DX(I)
        DY(I + 1) = DX(I + 1)
        DY(I + 2) = DX(I + 2)
        DY(I + 3) = DX(I + 3)
        DY(I + 4) = DX(I + 4)
        DY(I + 5) = DX(I + 5)
        DY(I + 6) = DX(I + 6)
   50 CONTINUE
      RETURN
*
C        CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
*
   60 CONTINUE
      NS=N*INCX
          DO 70 I=1,NS,INCX
          DY(I) = DX(I)
   70     CONTINUE
      RETURN
      END
*DDOT
      DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
C***BEGIN PROLOGUE  DDOT
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A4
C***KEYWORDS  BLAS,DOUBLE PRECISION,INNER PRODUCT,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  D.P. INNER PRODUCT OF D.P. VECTORS
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C       DY  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF DY
C     --OUTPUT--
C     DDOT  DOUBLE PRECISION DOT PRODUCT (ZERO IF N .LE. 0)
C     RETURNS THE DOT PRODUCT OF DOUBLE PRECISION DX AND DY.
C     DDOT = SUM FOR I = 0 TO N-1 OF  DX(LX+I*INCX) * DY(LY+I*INCY)
C     WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS
C     DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DDOT
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*),DY(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DDOT
*
*
      DDOT = 0.D0
      IF(N.LE.0)RETURN
      IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60
    5 CONTINUE
*
C         CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
         DDOT = DDOT + DX(IX)*DY(IY)
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C        CODE FOR BOTH INCREMENTS EQUAL TO 1.
*
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5.
*
   20 M = MOD(N,5)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
         DDOT = DDOT + DX(I)*DY(I)
   30 CONTINUE
      IF( N .LT. 5 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,5
         DDOT = DDOT + DX(I)*DY(I) + DX(I+1)*DY(I+1) +
     1   DX(I + 2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4)
   50 CONTINUE
      RETURN
*
C         CODE FOR POSITIVE EQUAL INCREMENTS .NE.1.
*
   60 CONTINUE
      NS = N*INCX
          DO 70 I=1,NS,INCX
          DDOT = DDOT + DX(I)*DY(I)
   70     CONTINUE
      RETURN
      END
*DNRM2
      DOUBLE PRECISION FUNCTION DNRM2(N,DX,INCX)
C***BEGIN PROLOGUE  DNRM2
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A3B
C***KEYWORDS  BLAS,DOUBLE PRECISION,EUCLIDEAN,L2,LENGTH,LINEAR ALGEBRA,
C             NORM,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  EUCLIDEAN LENGTH (L2 NORM) OF D.P. VECTOR
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C     --OUTPUT--
C    DNRM2  DOUBLE PRECISION RESULT (ZERO IF N .LE. 0)
C     EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE
C     INCREMENT INCX .
C     IF    N .LE. 0 RETURN WITH RESULT = 0.
C     IF N .GE. 1 THEN INCX MUST BE .GE. 1
C           C.L. LAWSON, 1978 JAN 08
C     FOUR PHASE METHOD     USING TWO BUILT-IN CONSTANTS THAT ARE
C     HOPEFULLY APPLICABLE TO ALL MACHINES.
C         CUTLO = MAXIMUM OF  DSQRT(U/EPS)  OVER ALL KNOWN MACHINES.
C         CUTHI = MINIMUM OF  DSQRT(V)      OVER ALL KNOWN MACHINES.
C     WHERE
C         EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1.
C         U   = SMALLEST POSITIVE NO.   (UNDERFLOW LIMIT)
C         V   = LARGEST  NO.            (OVERFLOW  LIMIT)
C     BRIEF OUTLINE OF ALGORITHM..
C     PHASE 1    SCANS ZERO COMPONENTS.
C     MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO
C     MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO
C     MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M
C     WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX.
*
C     VALUES FOR CUTLO AND CUTHI..
C     FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER
C     DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS..
C     CUTLO, S.P.   U/EPS = 2**(-102) FOR  HONEYWELL.  CLOSE SECONDS ARE
C                   UNIVAC AND DEC AT 2**(-103)
C                   THUS CUTLO = 2**(-51) = 4.44089E-16
C     CUTHI, S.P.   V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC.
C                   THUS CUTHI = 2**(63.5) = 1.30438E19
C     CUTLO, D.P.   U/EPS = 2**(-67) FOR HONEYWELL AND DEC.
C                   THUS CUTLO = 2**(-33.5) = 8.23181D-11
C     CUTHI, D.P.   SAME AS S.P.  CUTHI = 1.30438D19
C     DATA CUTLO, CUTHI / 8.232D-11,  1.304D19 /
C     DATA CUTLO, CUTHI / 4.441E-16,  1.304E19 /
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DNRM2
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   CUTHI,CUTLO,HITEST,ONE,SUM,XMAX,ZERO
      INTEGER
     +   I,J,NEXT,NN
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   DABS,DSQRT,FLOAT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE/0.0D0,1.0D0/
      DATA
     +   CUTLO,CUTHI/8.232D-11,1.304D19/
*
*
C***FIRST EXECUTABLE STATEMENT  DNRM2
*
*
      XMAX = ZERO
      IF(N .GT. 0) GO TO 10
         DNRM2  = ZERO
         GO TO 300
*
   10 ASSIGN 30 TO NEXT
      SUM = ZERO
      NN = N * INCX
C                                                 BEGIN MAIN LOOP
      I = 1
C  20 GO TO NEXT,(30, 50, 70, 110)
   20 GO TO NEXT
   30 IF( DABS(DX(I)) .GT. CUTLO) GO TO 85
      ASSIGN 50 TO NEXT
      XMAX = ZERO
*
C                        PHASE 1.  SUM IS ZERO
*
   50 IF( DX(I) .EQ. ZERO) GO TO 200
      IF( DABS(DX(I)) .GT. CUTLO) GO TO 85
*
C                                PREPARE FOR PHASE 2.
      ASSIGN 70 TO NEXT
      GO TO 105
*
C                                PREPARE FOR PHASE 4.
*
  100 I = J
      ASSIGN 110 TO NEXT
      SUM = (SUM / DX(I)) / DX(I)
  105 XMAX = DABS(DX(I))
      GO TO 115
*
C                   PHASE 2.  SUM IS SMALL.
C                             SCALE TO AVOID DESTRUCTIVE UNDERFLOW.
*
   70 IF( DABS(DX(I)) .GT. CUTLO ) GO TO 75
*
C                     COMMON CODE FOR PHASES 2 AND 4.
C                     IN PHASE 4 SUM IS LARGE.  SCALE TO AVOID OVERFLOW.
*
  110 IF( DABS(DX(I)) .LE. XMAX ) GO TO 115
         SUM = ONE + SUM * (XMAX / DX(I))**2
         XMAX = DABS(DX(I))
         GO TO 200
*
  115 SUM = SUM + (DX(I)/XMAX)**2
      GO TO 200
*
*
C                  PREPARE FOR PHASE 3.
*
   75 SUM = (SUM * XMAX) * XMAX
*
*
C     FOR REAL OR D.P. SET HITEST = CUTHI/N
C     FOR COMPLEX      SET HITEST = CUTHI/(2*N)
*
   85 HITEST = CUTHI/FLOAT( N )
*
C                   PHASE 3.  SUM IS MID-RANGE.  NO SCALING.
*
      DO 95 J =I,NN,INCX
      IF(DABS(DX(J)) .GE. HITEST) GO TO 100
   95    SUM = SUM + DX(J)**2
      DNRM2 = DSQRT( SUM )
      GO TO 300
*
  200 CONTINUE
      I = I + INCX
      IF ( I .LE. NN ) GO TO 20
*
C              END OF MAIN LOOP.
*
C              COMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
*
      DNRM2 = XMAX * DSQRT(SUM)
  300 CONTINUE
      RETURN
      END
*DPODI
      SUBROUTINE DPODI(A,LDA,N,DET,JOB)
C***BEGIN PROLOGUE  DPODI
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D2B1B,D3B1B
C***KEYWORDS  DETERMINANT,DOUBLE PRECISION,FACTOR,INVERSE,
C             LINEAR ALGEBRA,LINPACK,MATRIX,POSITIVE DEFINITE
C***AUTHOR  MOLER, C. B., (U. OF NEW MEXICO)
C***PURPOSE  COMPUTES THE DETERMINANT AND INVERSE OF A CERTAIN DOUBLE
C            PRECISION SYMMETRIC POSITIVE DEFINITE MATRIX (SEE ABSTRACT)
C            USING THE FACTORS COMPUTED BY DPOCO, DPOFA OR DQRDC.
C***DESCRIPTION
C     DPODI COMPUTES THE DETERMINANT AND INVERSE OF A CERTAIN
C     DOUBLE PRECISION SYMMETRIC POSITIVE DEFINITE MATRIX (SEE BELOW)
C     USING THE FACTORS COMPUTED BY DPOCO, DPOFA OR DQRDC.
C     ON ENTRY
C        A       DOUBLE PRECISION(LDA, N)
C                THE OUTPUT  A  FROM DPOCO OR DPOFA
C                OR THE OUTPUT  X  FROM DQRDC.
C        LDA     INTEGER
C                THE LEADING DIMENSION OF THE ARRAY  A .
C        N       INTEGER
C                THE ORDER OF THE MATRIX  A .
C        JOB     INTEGER
C                = 11   BOTH DETERMINANT AND INVERSE.
C                = 01   INVERSE ONLY.
C                = 10   DETERMINANT ONLY.
C     ON RETURN
C        A       IF DPOCO OR DPOFA WAS USED TO FACTOR  A , THEN
C                DPODI PRODUCES THE UPPER HALF OF INVERSE(A) .
C                IF DQRDC WAS USED TO DECOMPOSE  X , THEN
C                DPODI PRODUCES THE UPPER HALF OF INVERSE(TRANS(X)*X)
C                WHERE TRANS(X) IS THE TRANSPOSE.
C                ELEMENTS OF  A  BELOW THE DIAGONAL ARE UNCHANGED.
C                IF THE UNITS DIGIT OF JOB IS ZERO,  A  IS UNCHANGED.
C        DET     DOUBLE PRECISION(2)
C                DETERMINANT OF  A  OR OF  TRANS(X)*X  IF REQUESTED.
C                OTHERWISE NOT REFERENCED.
C                DETERMINANT = DET(1) * 10.0**DET(2)
C                WITH  1.0 .LE. DET(1) .LT. 10.0
C                OR  DET(1) .EQ. 0.0 .
C     ERROR CONDITION
C        A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS
C        A ZERO ON THE DIAGONAL AND THE INVERSE IS REQUESTED.
C        IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED CORRECTLY
C        AND IF DPOCO OR DPOFA HAS SET INFO .EQ. 0 .
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  DAXPY,DSCAL
C***END PROLOGUE  DPODI
*
C...SCALAR ARGUMENTS
      INTEGER JOB,LDA,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION A(LDA,*),DET(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION S,T
      INTEGER I,J,JM1,K,KP1
*
C...EXTERNAL SUBROUTINES
      EXTERNAL DAXPY,DSCAL
*
C...INTRINSIC FUNCTIONS
      INTRINSIC MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DPODI
*
*
      IF (JOB/10 .EQ. 0) GO TO 70
         DET(1) = 1.0D0
         DET(2) = 0.0D0
         S = 10.0D0
         DO 50 I = 1, N
            DET(1) = A(I,I)**2*DET(1)
C        ...EXIT
            IF (DET(1) .EQ. 0.0D0) GO TO 60
   10       IF (DET(1) .GE. 1.0D0) GO TO 20
               DET(1) = S*DET(1)
               DET(2) = DET(2) - 1.0D0
            GO TO 10
   20       CONTINUE
   30       IF (DET(1) .LT. S) GO TO 40
               DET(1) = DET(1)/S
               DET(2) = DET(2) + 1.0D0
            GO TO 30
   40       CONTINUE
   50    CONTINUE
   60    CONTINUE
   70 CONTINUE
*
C     COMPUTE INVERSE(R)
*
      IF (MOD(JOB,10) .EQ. 0) GO TO 140
         DO 100 K = 1, N
            A(K,K) = 1.0D0/A(K,K)
            T = -A(K,K)
            CALL DSCAL(K-1,T,A(1,K),1)
            KP1 = K + 1
            IF (N .LT. KP1) GO TO 90
            DO 80 J = KP1, N
               T = A(K,J)
               A(K,J) = 0.0D0
               CALL DAXPY(K,T,A(1,K),1,A(1,J),1)
   80       CONTINUE
   90       CONTINUE
  100    CONTINUE
*
C        FORM  INVERSE(R) * TRANS(INVERSE(R))
*
         DO 130 J = 1, N
            JM1 = J - 1
            IF (JM1 .LT. 1) GO TO 120
            DO 110 K = 1, JM1
               T = A(K,J)
               CALL DAXPY(K,T,A(1,J),1,A(1,K),1)
  110       CONTINUE
  120       CONTINUE
            T = A(J,J)
            CALL DSCAL(J,T,A(1,J),1)
  130    CONTINUE
  140 CONTINUE
      RETURN
      END
*DQRDC
      SUBROUTINE DQRDC(X,LDX,N,P,QRAUX,JPVT,WORK,JOB)
C***BEGIN PROLOGUE  DQRDC
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D5
C***KEYWORDS  DECOMPOSITION,DOUBLE PRECISION,LINEAR ALGEBRA,LINPACK,
C             MATRIX,ORTHOGONAL TRIANGULAR
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  USES HOUSEHOLDER TRANSFORMATIONS TO COMPUTE THE QR FACTORI-
C            ZATION OF N BY P MATRIX X.  COLUMN PIVOTING IS OPTIONAL.
C***DESCRIPTION
C     DQRDC USES HOUSEHOLDER TRANSFORMATIONS TO COMPUTE THE QR
C     FACTORIZATION OF AN N BY P MATRIX X.  COLUMN PIVOTING
C     BASED ON THE 2-NORMS OF THE REDUCED COLUMNS MAY BE
C     PERFORMED AT THE USER'S OPTION.
C     ON ENTRY
C        X       DOUBLE PRECISION(LDX,P), WHERE LDX .GE. N.
C                X CONTAINS THE MATRIX WHOSE DECOMPOSITION IS TO BE
C                COMPUTED.
C        LDX     INTEGER.
C                LDX IS THE LEADING DIMENSION OF THE ARRAY X.
C        N       INTEGER.
C                N IS THE NUMBER OF ROWS OF THE MATRIX X.
C        P       INTEGER.
C                P IS THE NUMBER OF COLUMNS OF THE MATRIX X.
C        JPVT    INTEGER(P).
C                JPVT CONTAINS INTEGERS THAT CONTROL THE SELECTION
C                OF THE PIVOT COLUMNS.  THE K-TH COLUMN X(K) OF X
C                IS PLACED IN ONE OF THREE CLASSES ACCORDING TO THE
C                VALUE OF JPVT(K).
C                   IF JPVT(K) .GT. 0, THEN X(K) IS AN INITIAL
C                                      COLUMN.
C                   IF JPVT(K) .EQ. 0, THEN X(K) IS A FREE COLUMN.
C                   IF JPVT(K) .LT. 0, THEN X(K) IS A FINAL COLUMN.
C                BEFORE THE DECOMPOSITION IS COMPUTED, INITIAL COLUMNS
C                ARE MOVED TO THE BEGINNING OF THE ARRAY X AND FINAL
C                COLUMNS TO THE END.  BOTH INITIAL AND FINAL COLUMNS
C                ARE FROZEN IN PLACE DURING THE COMPUTATION AND ONLY
C                FREE COLUMNS ARE MOVED.  AT THE K-TH STAGE OF THE
C                REDUCTION, IF X(K) IS OCCUPIED BY A FREE COLUMN
C                IT IS INTERCHANGED WITH THE FREE COLUMN OF LARGEST
C                REDUCED NORM.  JPVT IS NOT REFERENCED IF
C                JOB .EQ. 0.
C        WORK    DOUBLE PRECISION(P).
C                WORK IS A WORK ARRAY.  WORK IS NOT REFERENCED IF
C                JOB .EQ. 0.
C        JOB     INTEGER.
C                JOB IS AN INTEGER THAT INITIATES COLUMN PIVOTING.
C                IF JOB .EQ. 0, NO PIVOTING IS DONE.
C                IF JOB .NE. 0, PIVOTING IS DONE.
C     ON RETURN
C        X       X CONTAINS IN ITS UPPER TRIANGLE THE UPPER
C                TRIANGULAR MATRIX R OF THE QR FACTORIZATION.
C                BELOW ITS DIAGONAL X CONTAINS INFORMATION FROM
C                WHICH THE ORTHOGONAL PART OF THE DECOMPOSITION
C                CAN BE RECOVERED.  NOTE THAT IF PIVOTING HAS
C                BEEN REQUESTED, THE DECOMPOSITION IS NOT THAT
C                OF THE ORIGINAL MATRIX X BUT THAT OF X
C                WITH ITS COLUMNS PERMUTED AS DESCRIBED BY JPVT.
C        QRAUX   DOUBLE PRECISION(P).
C                QRAUX CONTAINS FURTHER INFORMATION REQUIRED TO RECOVER
C                THE ORTHOGONAL PART OF THE DECOMPOSITION.
C        JPVT    JPVT(K) CONTAINS THE INDEX OF THE COLUMN OF THE
C                ORIGINAL MATRIX THAT HAS BEEN INTERCHANGED INTO
C                THE K-TH COLUMN, IF PIVOTING WAS REQUESTED.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  DAXPY,DDOT,DNRM2,DSCAL,DSWAP
C***END PROLOGUE  DQRDC
*
C...SCALAR ARGUMENTS
      INTEGER
     +   JOB,LDX,N,P
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   QRAUX(*),WORK(*),X(LDX,*)
      INTEGER
     +   JPVT(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   MAXNRM,NRMXL,T,TT
      INTEGER
     +   J,JJ,JP,L,LP1,LUP,MAXJ,PL,PU
      LOGICAL
     +   NEGJ,SWAPJ
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DDOT,DNRM2
      EXTERNAL
     +   DDOT,DNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DAXPY,DSCAL,DSWAP
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   DABS,DMAX1,DSIGN,DSQRT,MIN0
*
*
C***FIRST EXECUTABLE STATEMENT  DQRDC
*
*
      PL = 1
      PU = 0
      IF (JOB .EQ. 0) GO TO 60
*
C        PIVOTING HAS BEEN REQUESTED.  REARRANGE THE COLUMNS
C        ACCORDING TO JPVT.
*
         DO 20 J = 1, P
            SWAPJ = JPVT(J) .GT. 0
            NEGJ = JPVT(J) .LT. 0
            JPVT(J) = J
            IF (NEGJ) JPVT(J) = -J
            IF (.NOT.SWAPJ) GO TO 10
               IF (J .NE. PL) CALL DSWAP(N,X(1,PL),1,X(1,J),1)
               JPVT(J) = JPVT(PL)
               JPVT(PL) = J
               PL = PL + 1
   10       CONTINUE
   20    CONTINUE
         PU = P
         DO 50 JJ = 1, P
            J = P - JJ + 1
            IF (JPVT(J) .GE. 0) GO TO 40
               JPVT(J) = -JPVT(J)
               IF (J .EQ. PU) GO TO 30
                  CALL DSWAP(N,X(1,PU),1,X(1,J),1)
                  JP = JPVT(PU)
                  JPVT(PU) = JPVT(J)
                  JPVT(J) = JP
   30          CONTINUE
               PU = PU - 1
   40       CONTINUE
   50    CONTINUE
   60 CONTINUE
*
C     COMPUTE THE NORMS OF THE FREE COLUMNS.
*
      IF (PU .LT. PL) GO TO 80
      DO 70 J = PL, PU
         QRAUX(J) = DNRM2(N,X(1,J),1)
         WORK(J) = QRAUX(J)
   70 CONTINUE
   80 CONTINUE
*
C     PERFORM THE HOUSEHOLDER REDUCTION OF X.
*
      LUP = MIN0(N,P)
      DO 200 L = 1, LUP
         IF (L .LT. PL .OR. L .GE. PU) GO TO 120
*
C           LOCATE THE COLUMN OF LARGEST NORM AND BRING IT
C           INTO THE PIVOT POSITION.
*
            MAXNRM = 0.0D0
            MAXJ = L
            DO 100 J = L, PU
               IF (QRAUX(J) .LE. MAXNRM) GO TO 90
                  MAXNRM = QRAUX(J)
                  MAXJ = J
   90          CONTINUE
  100       CONTINUE
            IF (MAXJ .EQ. L) GO TO 110
               CALL DSWAP(N,X(1,L),1,X(1,MAXJ),1)
               QRAUX(MAXJ) = QRAUX(L)
               WORK(MAXJ) = WORK(L)
               JP = JPVT(MAXJ)
               JPVT(MAXJ) = JPVT(L)
               JPVT(L) = JP
  110       CONTINUE
  120    CONTINUE
         QRAUX(L) = 0.0D0
         IF (L .EQ. N) GO TO 190
*
C           COMPUTE THE HOUSEHOLDER TRANSFORMATION FOR COLUMN L.
*
            NRMXL = DNRM2(N-L+1,X(L,L),1)
            IF (NRMXL .EQ. 0.0D0) GO TO 180
               IF (X(L,L) .NE. 0.0D0) NRMXL = DSIGN(NRMXL,X(L,L))
               CALL DSCAL(N-L+1,1.0D0/NRMXL,X(L,L),1)
               X(L,L) = 1.0D0 + X(L,L)
*
C              APPLY THE TRANSFORMATION TO THE REMAINING COLUMNS,
C              UPDATING THE NORMS.
*
               LP1 = L + 1
               IF (P .LT. LP1) GO TO 170
               DO 160 J = LP1, P
                  T = -DDOT(N-L+1,X(L,L),1,X(L,J),1)/X(L,L)
                  CALL DAXPY(N-L+1,T,X(L,L),1,X(L,J),1)
                  IF (J .LT. PL .OR. J .GT. PU) GO TO 150
                  IF (QRAUX(J) .EQ. 0.0D0) GO TO 150
                     TT = 1.0D0 - (DABS(X(L,J))/QRAUX(J))**2
                     TT = DMAX1(TT,0.0D0)
                     T = TT
                     TT = 1.0D0 + 0.05D0*TT*(QRAUX(J)/WORK(J))**2
                     IF (TT .EQ. 1.0D0) GO TO 130
                        QRAUX(J) = QRAUX(J)*DSQRT(T)
                     GO TO 140
  130                CONTINUE
                        QRAUX(J) = DNRM2(N-L,X(L+1,J),1)
                        WORK(J) = QRAUX(J)
  140                CONTINUE
  150             CONTINUE
  160          CONTINUE
  170          CONTINUE
*
C              SAVE THE TRANSFORMATION.
*
               QRAUX(L) = X(L,L)
               X(L,L) = -NRMXL
  180       CONTINUE
  190    CONTINUE
  200 CONTINUE
      RETURN
      END
*DQRSL
      SUBROUTINE DQRSL(X,LDX,N,K,QRAUX,Y,QY,QTY,B,RSD,XB,JOB,INFO)
C***BEGIN PROLOGUE  DQRSL
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D9,D2A1
C***KEYWORDS  DOUBLE PRECISION,LINEAR ALGEBRA,LINPACK,MATRIX,
C             ORTHOGONAL TRIANGULAR,SOLVE
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  APPLIES THE OUTPUT OF DQRDC TO COMPUTE COORDINATE
C            TRANSFORMATIONS, PROJECTIONS, AND LEAST SQUARES SOLUTIONS.
C***DESCRIPTION
C     DQRSL APPLIES THE OUTPUT OF DQRDC TO COMPUTE COORDINATE
C     TRANSFORMATIONS, PROJECTIONS, AND LEAST SQUARES SOLUTIONS.
C     FOR K .LE. MIN(N,P), LET XK BE THE MATRIX
C            XK = (X(JPVT(1)),X(JPVT(2)), ... ,X(JPVT(K)))
C     FORMED FROM COLUMNNS JPVT(1), ... ,JPVT(K) OF THE ORIGINAL
C     N X P MATRIX X THAT WAS INPUT TO DQRDC (IF NO PIVOTING WAS
C     DONE, XK CONSISTS OF THE FIRST K COLUMNS OF X IN THEIR
C     ORIGINAL ORDER).  DQRDC PRODUCES A FACTORED ORTHOGONAL MATRIX Q
C     AND AN UPPER TRIANGULAR MATRIX R SUCH THAT
C              XK = Q * (R)
C                       (0)
C     THIS INFORMATION IS CONTAINED IN CODED FORM IN THE ARRAYS
C     X AND QRAUX.
C     ON ENTRY
C        X      DOUBLE PRECISION(LDX,P).
C               X CONTAINS THE OUTPUT OF DQRDC.
C        LDX    INTEGER.
C               LDX IS THE LEADING DIMENSION OF THE ARRAY X.
C        N      INTEGER.
C               N IS THE NUMBER OF ROWS OF THE MATRIX XK.  IT MUST
C               HAVE THE SAME VALUE AS N IN DQRDC.
C        K      INTEGER.
C               K IS THE NUMBER OF COLUMNS OF THE MATRIX XK.  K
C               MUST NOT BE GREATER THAN MIN(N,P), WHERE P IS THE
C               SAME AS IN THE CALLING SEQUENCE TO DQRDC.
C        QRAUX  DOUBLE PRECISION(P).
C               QRAUX CONTAINS THE AUXILIARY OUTPUT FROM DQRDC.
C        Y      DOUBLE PRECISION(N)
C               Y CONTAINS AN N-VECTOR THAT IS TO BE MANIPULATED
C               BY DQRSL.
C        JOB    INTEGER.
C               JOB SPECIFIES WHAT IS TO BE COMPUTED.  JOB HAS
C               THE DECIMAL EXPANSION ABCDE, WITH THE FOLLOWING
C               MEANING.
C                    IF A .NE. 0, COMPUTE QY.
C                    IF B,C,D, OR E .NE. 0, COMPUTE QTY.
C                    IF C .NE. 0, COMPUTE B.
C                    IF D .NE. 0, COMPUTE RSD.
C                    IF E .NE. 0, COMPUTE XB.
C               NOTE THAT A REQUEST TO COMPUTE B, RSD, OR XB
C               AUTOMATICALLY TRIGGERS THE COMPUTATION OF QTY, FOR
C               WHICH AN ARRAY MUST BE PROVIDED IN THE CALLING
C               SEQUENCE.
C     ON RETURN
C        QY     DOUBLE PRECISION(N).
C               QY CONTAINS Q*Y, IF ITS COMPUTATION HAS BEEN
C               REQUESTED.
C        QTY    DOUBLE PRECISION(N).
C               QTY CONTAINS TRANS(Q)*Y, IF ITS COMPUTATION HAS
C               BEEN REQUESTED.  HERE TRANS(Q) IS THE
C               TRANSPOSE OF THE MATRIX Q.
C        B      DOUBLE PRECISION(K)
C               B CONTAINS THE SOLUTION OF THE LEAST SQUARES PROBLEM
C                    MINIMIZE NORM2(Y - XK*B),
C               IF ITS COMPUTATION HAS BEEN REQUESTED.  (NOTE THAT
C               IF PIVOTING WAS REQUESTED IN DQRDC, THE J-TH
C               COMPONENT OF B WILL BE ASSOCIATED WITH COLUMN JPVT(J)
C               OF THE ORIGINAL MATRIX X THAT WAS INPUT INTO DQRDC.)
C        RSD    DOUBLE PRECISION(N).
C               RSD CONTAINS THE LEAST SQUARES RESIDUAL Y - XK*B,
C               IF ITS COMPUTATION HAS BEEN REQUESTED.  RSD IS
C               ALSO THE ORTHOGONAL PROJECTION OF Y ONTO THE
C               ORTHOGONAL COMPLEMENT OF THE COLUMN SPACE OF XK.
C        XB     DOUBLE PRECISION(N).
C               XB CONTAINS THE LEAST SQUARES APPROXIMATION XK*B,
C               IF ITS COMPUTATION HAS BEEN REQUESTED.  XB IS ALSO
C               THE ORTHOGONAL PROJECTION OF Y ONTO THE COLUMN SPACE
C               OF X.
C        INFO   INTEGER.
C               INFO IS ZERO UNLESS THE COMPUTATION OF B HAS
C               BEEN REQUESTED AND R IS EXACTLY SINGULAR.  IN
C               THIS CASE, INFO IS THE INDEX OF THE FIRST ZERO
C               DIAGONAL ELEMENT OF R AND B IS LEFT UNALTERED.
C     THE PARAMETERS QY, QTY, B, RSD, AND XB ARE NOT REFERENCED
C     IF THEIR COMPUTATION IS NOT REQUESTED AND IN THIS CASE
C     CAN BE REPLACED BY DUMMY VARIABLES IN THE CALLING PROGRAM.
C     TO SAVE STORAGE, THE USER MAY IN SOME CASES USE THE SAME
C     ARRAY FOR DIFFERENT PARAMETERS IN THE CALLING SEQUENCE.  A
C     FREQUENTLY OCCURING EXAMPLE IS WHEN ONE WISHES TO COMPUTE
C     ANY OF B, RSD, OR XB AND DOES NOT NEED Y OR QTY.  IN THIS
C     CASE ONE MAY IDENTIFY Y, QTY, AND ONE OF B, RSD, OR XB, WHILE
C     PROVIDING SEPARATE ARRAYS FOR ANYTHING ELSE THAT IS TO BE
C     COMPUTED.  THUS THE CALLING SEQUENCE
C          CALL DQRSL(X,LDX,N,K,QRAUX,Y,DUM,Y,B,Y,DUM,110,INFO)
C     WILL RESULT IN THE COMPUTATION OF B AND RSD, WITH RSD
C     OVERWRITING Y.  MORE GENERALLY, EACH ITEM IN THE FOLLOWING
C     LIST CONTAINS GROUPS OF PERMISSIBLE IDENTIFICATIONS FOR
C     A SINGLE CALLING SEQUENCE.
C          1. (Y,QTY,B) (RSD) (XB) (QY)
C          2. (Y,QTY,RSD) (B) (XB) (QY)
C          3. (Y,QTY,XB) (B) (RSD) (QY)
C          4. (Y,QY) (QTY,B) (RSD) (XB)
C          5. (Y,QY) (QTY,RSD) (B) (XB)
C          6. (Y,QY) (QTY,XB) (B) (RSD)
C     IN ANY GROUP THE VALUE RETURNED IN THE ARRAY ALLOCATED TO
C     THE GROUP CORRESPONDS TO THE LAST MEMBER OF THE GROUP.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  DAXPY,DCOPY,DDOT
C***END PROLOGUE  DQRSL
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,JOB,K,LDX,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   B(*),QRAUX(*),QTY(*),QY(*),RSD(*),X(LDX,*),XB(*),
     +   Y(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   T,TEMP
      INTEGER
     +   I,J,JJ,JU,KP1
      LOGICAL
     +   CB,CQTY,CQY,CR,CXB
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DDOT
      EXTERNAL
     +   DDOT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DAXPY,DCOPY
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MIN0,MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DQRSL
*
*
      INFO = 0
*
C     DETERMINE WHAT IS TO BE COMPUTED.
*
      CQY = JOB/10000 .NE. 0
      CQTY = MOD(JOB,10000) .NE. 0
      CB = MOD(JOB,1000)/100 .NE. 0
      CR = MOD(JOB,100)/10 .NE. 0
      CXB = MOD(JOB,10) .NE. 0
      JU = MIN0(K,N-1)
*
C     SPECIAL ACTION WHEN N=1.
*
      IF (JU .NE. 0) GO TO 40
         IF (CQY) QY(1) = Y(1)
         IF (CQTY) QTY(1) = Y(1)
         IF (CXB) XB(1) = Y(1)
         IF (.NOT.CB) GO TO 30
            IF (X(1,1) .NE. 0.0D0) GO TO 10
               INFO = 1
            GO TO 20
   10       CONTINUE
               B(1) = Y(1)/X(1,1)
   20       CONTINUE
   30    CONTINUE
         IF (CR) RSD(1) = 0.0D0
      GO TO 250
   40 CONTINUE
*
C        SET UP TO COMPUTE QY OR QTY.
*
         IF (CQY) CALL DCOPY(N,Y,1,QY,1)
         IF (CQTY) CALL DCOPY(N,Y,1,QTY,1)
         IF (.NOT.CQY) GO TO 70
*
C           COMPUTE QY.
*
            DO 60 JJ = 1, JU
               J = JU - JJ + 1
               IF (QRAUX(J) .EQ. 0.0D0) GO TO 50
                  TEMP = X(J,J)
                  X(J,J) = QRAUX(J)
                  T = -DDOT(N-J+1,X(J,J),1,QY(J),1)/X(J,J)
                  CALL DAXPY(N-J+1,T,X(J,J),1,QY(J),1)
                  X(J,J) = TEMP
   50          CONTINUE
   60       CONTINUE
   70    CONTINUE
         IF (.NOT.CQTY) GO TO 100
*
C           COMPUTE TRANS(Q)*Y.
*
            DO 90 J = 1, JU
               IF (QRAUX(J) .EQ. 0.0D0) GO TO 80
                  TEMP = X(J,J)
                  X(J,J) = QRAUX(J)
                  T = -DDOT(N-J+1,X(J,J),1,QTY(J),1)/X(J,J)
                  CALL DAXPY(N-J+1,T,X(J,J),1,QTY(J),1)
                  X(J,J) = TEMP
   80          CONTINUE
   90       CONTINUE
  100    CONTINUE
*
C        SET UP TO COMPUTE B, RSD, OR XB.
*
         IF (CB) CALL DCOPY(K,QTY,1,B,1)
         KP1 = K + 1
         IF (CXB) CALL DCOPY(K,QTY,1,XB,1)
         IF (CR .AND. K .LT. N) CALL DCOPY(N-K,QTY(KP1),1,RSD(KP1),1)
         IF (.NOT.CXB .OR. KP1 .GT. N) GO TO 120
            DO 110 I = KP1, N
               XB(I) = 0.0D0
  110       CONTINUE
  120    CONTINUE
         IF (.NOT.CR) GO TO 140
            DO 130 I = 1, K
               RSD(I) = 0.0D0
  130       CONTINUE
  140    CONTINUE
         IF (.NOT.CB) GO TO 190
*
C           COMPUTE B.
*
            DO 170 JJ = 1, K
               J = K - JJ + 1
               IF (X(J,J) .NE. 0.0D0) GO TO 150
                  INFO = J
C           ......EXIT
                  GO TO 180
  150          CONTINUE
               B(J) = B(J)/X(J,J)
               IF (J .EQ. 1) GO TO 160
                  T = -B(J)
                  CALL DAXPY(J-1,T,X(1,J),1,B,1)
  160          CONTINUE
  170       CONTINUE
  180       CONTINUE
  190    CONTINUE
         IF (.NOT.CR .AND. .NOT.CXB) GO TO 240
*
C           COMPUTE RSD OR XB AS REQUIRED.
*
            DO 230 JJ = 1, JU
               J = JU - JJ + 1
               IF (QRAUX(J) .EQ. 0.0D0) GO TO 220
                  TEMP = X(J,J)
                  X(J,J) = QRAUX(J)
                  IF (.NOT.CR) GO TO 200
                     T = -DDOT(N-J+1,X(J,J),1,RSD(J),1)/X(J,J)
                     CALL DAXPY(N-J+1,T,X(J,J),1,RSD(J),1)
  200             CONTINUE
                  IF (.NOT.CXB) GO TO 210
                     T = -DDOT(N-J+1,X(J,J),1,XB(J),1)/X(J,J)
                     CALL DAXPY(N-J+1,T,X(J,J),1,XB(J),1)
  210             CONTINUE
                  X(J,J) = TEMP
  220          CONTINUE
  230       CONTINUE
  240    CONTINUE
  250 CONTINUE
      RETURN
      END
*DROT
      SUBROUTINE DROT(N,DX,INCX,DY,INCY,DC,DS)
C***BEGIN PROLOGUE  DROT
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A8
C***KEYWORDS  BLAS,GIVENS ROTATION,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  APPLY D.P. GIVENS ROTATION
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C       DY  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF DY
C       DC  D.P. ELEMENT OF ROTATION MATRIX
C       DS  D.P. ELEMENT OF ROTATION MATRIX
C     --OUTPUT--
C       DX  ROTATED VECTOR (UNCHANGED IF N .LE. 0)
C       DY  ROTATED VECTOR (UNCHANGED IF N .LE. 0)
C     MULTIPLY THE 2 X 2 MATRIX  ( DC DS) TIMES THE 2 X N MATRIX (DX**T)
C                                (-DS DC)                        (DY**T)
C     WHERE **T INDICATES TRANSPOSE.  THE ELEMENTS OF DX ARE IN
C     DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
C     LX = (-INCX)*N, AND SIMILARLY FOR DY USING LY AND INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DROT
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   DC,DS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*),DY(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   ONE,W,Z,ZERO
      INTEGER
     +   I,KX,KY,NSTEPS
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE/0.D0,1.D0/
*
*
C***FIRST EXECUTABLE STATEMENT  DROT
*
*
      IF(N .LE. 0 .OR. (DS .EQ. ZERO .AND. DC .EQ. ONE)) GO TO 40
      IF(.NOT. (INCX .EQ. INCY .AND. INCX .GT. 0)) GO TO 20
*
           NSTEPS=INCX*N
           DO 10 I=1,NSTEPS,INCX
                W=DX(I)
                Z=DY(I)
                DX(I)=DC*W+DS*Z
                DY(I)=-DS*W+DC*Z
   10           CONTINUE
           GO TO 40
*
   20 CONTINUE
           KX=1
           KY=1
*
           IF(INCX .LT. 0) KX=1-(N-1)*INCX
           IF(INCY .LT. 0) KY=1-(N-1)*INCY
*
           DO 30 I=1,N
                W=DX(KX)
                Z=DY(KY)
                DX(KX)=DC*W+DS*Z
                DY(KY)=-DS*W+DC*Z
                KX=KX+INCX
                KY=KY+INCY
   30           CONTINUE
   40 CONTINUE
*
      RETURN
      END
*DROTG
      SUBROUTINE DROTG(DA,DB,DC,DS)
C***BEGIN PROLOGUE  DROTG
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1B10
C***KEYWORDS  BLAS,GIVENS ROTATION,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  CONSTRUCT D.P. PLANE GIVENS ROTATION
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C       DA  DOUBLE PRECISION SCALAR
C       DB  DOUBLE PRECISION SCALAR
C     --OUTPUT--
C       DA  DOUBLE PRECISION RESULT R
C       DB  DOUBLE PRECISION RESULT Z
C       DC  DOUBLE PRECISION RESULT
C       DS  DOUBLE PRECISION RESULT
C     DESIGNED BY C. L. LAWSON, JPL, 1977 SEPT 08
C     CONSTRUCT THE GIVENS TRANSFORMATION
C         ( DC  DS )
C     G = (        ) ,    DC**2 + DS**2 = 1 ,
C         (-DS  DC )
C     WHICH ZEROS THE SECOND ENTRY OF THE 2-VECTOR  (DA,DB)**T .
C     THE QUANTITY R = (+/-)DSQRT(DA**2 + DB**2) OVERWRITES DA IN
C     STORAGE.  THE VALUE OF DB IS OVERWRITTEN BY A VALUE Z WHICH
C     ALLOWS DC AND DS TO BE RECOVERED BY THE FOLLOWING ALGORITHM.
C           IF Z=1  SET  DC=0.D0  AND  DS=1.D0
C           IF DABS(Z) .LT. 1  SET  DC=DSQRT(1-Z**2)  AND  DS=Z
C           IF DABS(Z) .GT. 1  SET  DC=1/Z  AND  DS=DSQRT(1-DC**2)
C     NORMALLY, THE SUBPROGRAM DROT(N,DX,INCX,DY,INCY,DC,DS) WILL
C     NEXT BE CALLED TO APPLY THE TRANSFORMATION TO A 2 BY N MATRIX.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DROTG
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   DA,DB,DC,DS
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   R,U,V
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   DABS,DSQRT
*
*
C***FIRST EXECUTABLE STATEMENT  DROTG
*
*
      IF (DABS(DA) .LE. DABS(DB)) GO TO 10
*
C     *** HERE DABS(DA) .GT. DABS(DB) ***
*
      U = DA + DA
      V = DB / U
*
C     NOTE THAT U AND R HAVE THE SIGN OF DA
*
      R = DSQRT(.25D0 + V**2) * U
*
C     NOTE THAT DC IS POSITIVE
*
      DC = DA / R
      DS = V * (DC + DC)
      DB = DS
      DA = R
      RETURN
*
C *** HERE DABS(DA) .LE. DABS(DB) ***
*
   10 IF (DB .EQ. 0.D0) GO TO 20
      U = DB + DB
      V = DA / U
*
C     NOTE THAT U AND R HAVE THE SIGN OF DB
C     (R IS IMMEDIATELY STORED IN DA)
*
      DA = DSQRT(.25D0 + V**2) * U
*
C     NOTE THAT DS IS POSITIVE
*
      DS = DB / DA
      DC = V * (DS + DS)
      IF (DC .EQ. 0.D0) GO TO 15
      DB = 1.D0 / DC
      RETURN
   15 DB = 1.D0
      RETURN
*
C *** HERE DA = DB = 0.D0 ***
*
   20 DC = 1.D0
      DS = 0.D0
      RETURN
*
      END
*DSCAL
      SUBROUTINE DSCAL(N,DA,DX,INCX)
C***BEGIN PROLOGUE  DSCAL
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A6
C***KEYWORDS  BLAS,LINEAR ALGEBRA,SCALE,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  D.P. VECTOR SCALE X = A*X
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DA  DOUBLE PRECISION SCALE FACTOR
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C     --OUTPUT--
C       DX  DOUBLE PRECISION RESULT (UNCHANGED IF N.LE.0)
C     REPLACE DOUBLE PRECISION DX BY DOUBLE PRECISION DA*DX.
C     FOR I = 0 TO N-1, REPLACE DX(1+I*INCX) WITH  DA * DX(1+I*INCX)
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DSCAL
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   DA
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DSCAL
*
*
      IF(N.LE.0)RETURN
      IF(INCX.EQ.1)GOTO 20
*
C        CODE FOR INCREMENTS NOT EQUAL TO 1.
*
      NS = N*INCX
          DO 10 I = 1,NS,INCX
          DX(I) = DA*DX(I)
   10     CONTINUE
      RETURN
*
C        CODE FOR INCREMENTS EQUAL TO 1.
*
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5.
*
   20 M = MOD(N,5)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        DX(I) = DA*DX(I)
   30 CONTINUE
      IF( N .LT. 5 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,5
        DX(I) = DA*DX(I)
        DX(I + 1) = DA*DX(I + 1)
        DX(I + 2) = DA*DX(I + 2)
        DX(I + 3) = DA*DX(I + 3)
        DX(I + 4) = DA*DX(I + 4)
   50 CONTINUE
      RETURN
      END
*DSWAP
      SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
C***BEGIN PROLOGUE  DSWAP
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A5
C***KEYWORDS  BLAS,DOUBLE PRECISION,INTERCHANGE,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  INTERCHANGE D.P. VECTORS
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C       DY  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF DY
C     --OUTPUT--
C       DX  INPUT VECTOR DY (UNCHANGED IF N .LE. 0)
C       DY  INPUT VECTOR DX (UNCHANGED IF N .LE. 0)
C     INTERCHANGE DOUBLE PRECISION DX AND DOUBLE PRECISION DY.
C     FOR I = 0 TO N-1, INTERCHANGE  DX(LX+I*INCX) AND DY(LY+I*INCY),
C     WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS
C     DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  DSWAP
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*),DY(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   DTEMP1,DTEMP2,DTEMP3
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DSWAP
*
*
      IF(N.LE.0)RETURN
      IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60
    5 CONTINUE
*
C       CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
        DTEMP1 = DX(IX)
        DX(IX) = DY(IY)
        DY(IY) = DTEMP1
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C       CODE FOR BOTH INCREMENTS EQUAL TO 1
*
*
C       CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 3.
*
   20 M = MOD(N,3)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        DTEMP1 = DX(I)
        DX(I) = DY(I)
        DY(I) = DTEMP1
   30 CONTINUE
      IF( N .LT. 3 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,3
        DTEMP1 = DX(I)
        DTEMP2 = DX(I+1)
        DTEMP3 = DX(I+2)
        DX(I) = DY(I)
        DX(I+1) = DY(I+1)
        DX(I+2) = DY(I+2)
        DY(I) = DTEMP1
        DY(I+1) = DTEMP2
        DY(I+2) = DTEMP3
   50 CONTINUE
      RETURN
   60 CONTINUE
*
C     CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
*
      NS = N*INCX
        DO 70 I=1,NS,INCX
        DTEMP1 = DX(I)
        DX(I) = DY(I)
        DY(I) = DTEMP1
   70   CONTINUE
      RETURN
      END
*DTRCO
      SUBROUTINE DTRCO(T,LDT,N,RCOND,Z,JOB)
C***BEGIN PROLOGUE  DTRCO
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D2A3
C***KEYWORDS  CONDITION,DOUBLE PRECISION,FACTOR,LINEAR ALGEBRA,LINPACK,
C             MATRIX,TRIANGULAR
C***AUTHOR  MOLER, C. B., (U. OF NEW MEXICO)
C***PURPOSE  ESTIMATES THE CONDITION OF A DOUBLE PRECISION TRIANGULAR
C            MATRIX.
C***DESCRIPTION
C     DTRCO ESTIMATES THE CONDITION OF A DOUBLE PRECISION TRIANGULAR
C     MATRIX.
C     ON ENTRY
C        T       DOUBLE PRECISION(LDT,N)
C                T CONTAINS THE TRIANGULAR MATRIX.  THE ZERO
C                ELEMENTS OF THE MATRIX ARE NOT REFERENCED, AND
C                THE CORRESPONDING ELEMENTS OF THE ARRAY CAN BE
C                USED TO STORE OTHER INFORMATION.
C        LDT     INTEGER
C                LDT IS THE LEADING DIMENSION OF THE ARRAY T.
C        N       INTEGER
C                N IS THE ORDER OF THE SYSTEM.
C        JOB     INTEGER
C                = 0         T  IS LOWER TRIANGULAR.
C                = NONZERO   T  IS UPPER TRIANGULAR.
C     ON RETURN
C        RCOND   DOUBLE PRECISION
C                AN ESTIMATE OF THE RECIPROCAL CONDITION OF  T .
C                FOR THE SYSTEM  T*X = B , RELATIVE PERTURBATIONS
C                IN  T  AND  B  OF SIZE  EPSILON  MAY CAUSE
C                RELATIVE PERTURBATIONS IN  X  OF SIZE  EPSILON/RCOND .
C                IF  RCOND  IS SO SMALL THAT THE LOGICAL EXPRESSION
C                           1.0 + RCOND .EQ. 1.0
C                IS TRUE, THEN  T  MAY BE SINGULAR TO WORKING
C                PRECISION.  IN PARTICULAR,  RCOND  IS ZERO  IF
C                EXACT SINGULARITY IS DETECTED OR THE ESTIMATE
C                UNDERFLOWS.
C        Z       DOUBLE PRECISION(N)
C                A WORK VECTOR WHOSE CONTENTS ARE USUALLY UNIMPORTANT.
C                IF  T  IS CLOSE TO A SINGULAR MATRIX, THEN  Z  IS
C                AN APPROXIMATE NULL VECTOR IN THE SENSE THAT
C                NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  DASUM,DAXPY,DSCAL
C***END PROLOGUE  DTRCO
*
C...SCALAR ARGUMENTS
      DOUBLE PRECISION
     +   RCOND
      INTEGER
     +   JOB,LDT,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   T(LDT,*),Z(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   EK,S,SM,TNORM,W,WK,WKM,YNORM
      INTEGER
     +   I1,J,J1,J2,K,KK,L
      LOGICAL
     +   LOWER
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DASUM
      EXTERNAL
     +   DASUM
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DAXPY,DSCAL
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   DABS,DMAX1,DSIGN
*
*
C***FIRST EXECUTABLE STATEMENT  DTRCO
*
*
      LOWER = JOB .EQ. 0
*
C     COMPUTE 1-NORM OF T
*
      TNORM = 0.0D0
      DO 10 J = 1, N
         L = J
         IF (LOWER) L = N + 1 - J
         I1 = 1
         IF (LOWER) I1 = J
         TNORM = DMAX1(TNORM,DASUM(L,T(I1,J),1))
   10 CONTINUE
*
C     RCOND = 1/(NORM(T)*(ESTIMATE OF NORM(INVERSE(T)))) .
C     ESTIMATE = NORM(Z)/NORM(Y) WHERE  T*Z = Y  AND  TRANS(T)*Y = E .
C     TRANS(T)  IS THE TRANSPOSE OF T .
C     THE COMPONENTS OF  E  ARE CHOSEN TO CAUSE MAXIMUM LOCAL
C     GROWTH IN THE ELEMENTS OF Y .
C     THE VECTORS ARE FREQUENTLY RESCALED TO AVOID OVERFLOW.
*
C     SOLVE TRANS(T)*Y = E
*
      EK = 1.0D0
      DO 20 J = 1, N
         Z(J) = 0.0D0
   20 CONTINUE
      DO 100 KK = 1, N
         K = KK
         IF (LOWER) K = N + 1 - KK
         IF (Z(K) .NE. 0.0D0) EK = DSIGN(EK,-Z(K))
         IF (DABS(EK-Z(K)) .LE. DABS(T(K,K))) GO TO 30
            S = DABS(T(K,K))/DABS(EK-Z(K))
            CALL DSCAL(N,S,Z,1)
            EK = S*EK
   30    CONTINUE
         WK = EK - Z(K)
         WKM = -EK - Z(K)
         S = DABS(WK)
         SM = DABS(WKM)
         IF (T(K,K) .EQ. 0.0D0) GO TO 40
            WK = WK/T(K,K)
            WKM = WKM/T(K,K)
         GO TO 50
   40    CONTINUE
            WK = 1.0D0
            WKM = 1.0D0
   50    CONTINUE
         IF (KK .EQ. N) GO TO 90
            J1 = K + 1
            IF (LOWER) J1 = 1
            J2 = N
            IF (LOWER) J2 = K - 1
            DO 60 J = J1, J2
               SM = SM + DABS(Z(J)+WKM*T(K,J))
               Z(J) = Z(J) + WK*T(K,J)
               S = S + DABS(Z(J))
   60       CONTINUE
            IF (S .GE. SM) GO TO 80
               W = WKM - WK
               WK = WKM
               DO 70 J = J1, J2
                  Z(J) = Z(J) + W*T(K,J)
   70          CONTINUE
   80       CONTINUE
   90    CONTINUE
         Z(K) = WK
  100 CONTINUE
      S = 1.0D0/DASUM(N,Z,1)
      CALL DSCAL(N,S,Z,1)
*
      YNORM = 1.0D0
*
C     SOLVE T*Z = Y
*
      DO 130 KK = 1, N
         K = N + 1 - KK
         IF (LOWER) K = KK
         IF (DABS(Z(K)) .LE. DABS(T(K,K))) GO TO 110
            S = DABS(T(K,K))/DABS(Z(K))
            CALL DSCAL(N,S,Z,1)
            YNORM = S*YNORM
  110    CONTINUE
         IF (T(K,K) .NE. 0.0D0) Z(K) = Z(K)/T(K,K)
         IF (T(K,K) .EQ. 0.0D0) Z(K) = 1.0D0
         I1 = 1
         IF (LOWER) I1 = K + 1
         IF (KK .GE. N) GO TO 120
            W = -Z(K)
            CALL DAXPY(N-KK,W,T(I1,K),1,Z(I1),1)
  120    CONTINUE
  130 CONTINUE
C     MAKE ZNORM = 1.0
      S = 1.0D0/DASUM(N,Z,1)
      CALL DSCAL(N,S,Z,1)
      YNORM = S*YNORM
*
      IF (TNORM .NE. 0.0D0) RCOND = YNORM/TNORM
      IF (TNORM .EQ. 0.0D0) RCOND = 0.0D0
      RETURN
      END
*DTRSL
      SUBROUTINE DTRSL(T,LDT,N,B,JOB,INFO)
C***BEGIN PROLOGUE  DTRSL
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D2A3
C***KEYWORDS  DOUBLE PRECISION,LINEAR ALGEBRA,LINPACK,MATRIX,SOLVE,
C             TRIANGULAR
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  SOLVES SYSTEMS OF THE FORM  T*X=B OR  TRANS(T)*X=B  WHERE T
C            IS A TRIANGULAR MATRIX OF ORDER N.
C***DESCRIPTION
C     DTRSL SOLVES SYSTEMS OF THE FORM
C                   T * X = B
C     OR
C                   TRANS(T) * X = B
C     WHERE T IS A TRIANGULAR MATRIX OF ORDER N.  HERE TRANS(T)
C     DENOTES THE TRANSPOSE OF THE MATRIX T.
C     ON ENTRY
C         T         DOUBLE PRECISION(LDT,N)
C                   T CONTAINS THE MATRIX OF THE SYSTEM.  THE ZERO
C                   ELEMENTS OF THE MATRIX ARE NOT REFERENCED, AND
C                   THE CORRESPONDING ELEMENTS OF THE ARRAY CAN BE
C                   USED TO STORE OTHER INFORMATION.
C         LDT       INTEGER
C                   LDT IS THE LEADING DIMENSION OF THE ARRAY T.
C         N         INTEGER
C                   N IS THE ORDER OF THE SYSTEM.
C         B         DOUBLE PRECISION(N).
C                   B CONTAINS THE RIGHT HAND SIDE OF THE SYSTEM.
C         JOB       INTEGER
C                   JOB SPECIFIES WHAT KIND OF SYSTEM IS TO BE SOLVED.
C                   IF JOB IS
C                        00   SOLVE T*X=B, T LOWER TRIANGULAR,
C                        01   SOLVE T*X=B, T UPPER TRIANGULAR,
C                        10   SOLVE TRANS(T)*X=B, T LOWER TRIANGULAR,
C                        11   SOLVE TRANS(T)*X=B, T UPPER TRIANGULAR.
C     ON RETURN
C         B         B CONTAINS THE SOLUTION, IF INFO .EQ. 0.
C                   OTHERWISE B IS UNALTERED.
C         INFO      INTEGER
C                   INFO CONTAINS ZERO IF THE SYSTEM IS NONSINGULAR.
C                   OTHERWISE INFO CONTAINS THE INDEX OF
C                   THE FIRST ZERO DIAGONAL ELEMENT OF T.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  DAXPY,DDOT
C***END PROLOGUE  DTRSL
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,JOB,LDT,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   B(*),T(LDT,*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   TEMP
      INTEGER
     +   CASE,J,JJ
*
C...EXTERNAL FUNCTIONS
      DOUBLE PRECISION
     +   DDOT
      EXTERNAL
     +   DDOT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   DAXPY
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  DTRSL
*
*
C     BEGIN BLOCK PERMITTING ...EXITS TO 150
*
C        CHECK FOR ZERO DIAGONAL ELEMENTS.
*
         DO 10 INFO = 1, N
C     ......EXIT
            IF (T(INFO,INFO) .EQ. 0.0D0) GO TO 150
   10    CONTINUE
         INFO = 0
*
C        DETERMINE THE TASK AND GO TO IT.
*
         CASE = 1
         IF (MOD(JOB,10) .NE. 0) CASE = 2
         IF (MOD(JOB,100)/10 .NE. 0) CASE = CASE + 2
         GO TO (20,50,80,110), CASE
*
C        SOLVE T*X=B FOR T LOWER TRIANGULAR
*
   20    CONTINUE
            B(1) = B(1)/T(1,1)
            IF (N .LT. 2) GO TO 40
            DO 30 J = 2, N
               TEMP = -B(J-1)
               CALL DAXPY(N-J+1,TEMP,T(J,J-1),1,B(J),1)
               B(J) = B(J)/T(J,J)
   30       CONTINUE
   40       CONTINUE
         GO TO 140
*
C        SOLVE T*X=B FOR T UPPER TRIANGULAR.
*
   50    CONTINUE
            B(N) = B(N)/T(N,N)
            IF (N .LT. 2) GO TO 70
            DO 60 JJ = 2, N
               J = N - JJ + 1
               TEMP = -B(J+1)
               CALL DAXPY(J,TEMP,T(1,J+1),1,B(1),1)
               B(J) = B(J)/T(J,J)
   60       CONTINUE
   70       CONTINUE
         GO TO 140
*
C        SOLVE TRANS(T)*X=B FOR T LOWER TRIANGULAR.
*
   80    CONTINUE
            B(N) = B(N)/T(N,N)
            IF (N .LT. 2) GO TO 100
            DO 90 JJ = 2, N
               J = N - JJ + 1
               B(J) = B(J) - DDOT(JJ-1,T(J+1,J),1,B(J+1),1)
               B(J) = B(J)/T(J,J)
   90       CONTINUE
  100       CONTINUE
         GO TO 140
*
C        SOLVE TRANS(T)*X=B FOR T UPPER TRIANGULAR.
*
  110    CONTINUE
            B(1) = B(1)/T(1,1)
            IF (N .LT. 2) GO TO 130
            DO 120 J = 2, N
               B(J) = B(J) - DDOT(J-1,T(1,J),1,B(1),1)
               B(J) = B(J)/T(J,J)
  120       CONTINUE
  130       CONTINUE
  140    CONTINUE
  150 CONTINUE
      RETURN
      END
*IDAMAX
      INTEGER FUNCTION IDAMAX(N,DX,INCX)
C***BEGIN PROLOGUE  IDAMAX
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A2
C***KEYWORDS  BLAS,DOUBLE PRECISION,LINEAR ALGEBRA,MAXIMUM COMPONENT,
C             VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  FIND LARGEST COMPONENT OF D.P. VECTOR
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       DX  DOUBLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF DX
C     --OUTPUT--
C   IDAMAX  SMALLEST INDEX (ZERO IF N .LE. 0)
C     FIND SMALLEST INDEX OF MAXIMUM MAGNITUDE OF DOUBLE PRECISION DX.
C     IDAMAX =  FIRST I, I = 1 TO N, TO MINIMIZE  ABS(DX(1-INCX+I*INCX)
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  IDAMAX
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      DOUBLE PRECISION
     +   DX(*)
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   DMAX,XMAG
      INTEGER
     +   I,II,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   DABS
*
*
C***FIRST EXECUTABLE STATEMENT  IDAMAX
*
*
      IDAMAX = 0
      IF(N.LE.0) RETURN
      IDAMAX = 1
      IF(N.LE.1)RETURN
      IF(INCX.EQ.1)GOTO 20
*
C        CODE FOR INCREMENTS NOT EQUAL TO 1.
*
      DMAX = DABS(DX(1))
      NS = N*INCX
      II = 1
          DO 10 I = 1,NS,INCX
          XMAG = DABS(DX(I))
          IF(XMAG.LE.DMAX) GO TO 5
          IDAMAX = II
          DMAX = XMAG
    5     II = II + 1
   10     CONTINUE
      RETURN
*
C        CODE FOR INCREMENTS EQUAL TO 1.
*
   20 DMAX = DABS(DX(1))
      DO 30 I = 2,N
          XMAG = DABS(DX(I))
          IF(XMAG.LE.DMAX) GO TO 30
          IDAMAX = I
          DMAX = XMAG
   30 CONTINUE
      RETURN
      END
*DMPREC
      DOUBLE PRECISION FUNCTION DMPREC()
C***BEGIN PROLOGUE  DPREC
C***REFER TO  DODR,DODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  DETERMINE MACHINE PRECISION FOR TARGET MACHINE AND COMPILER
C            ASSUMING FLOATING-POINT NUMBERS ARE REPRESENTED IN THE
C            T-DIGIT, BASE-B FORM
C                  SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
C            WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, AND
C                  0 .LT. X(1).
C            TO ALTER THIS FUNCTION FOR A PARTICULAR TARGET MACHINE,
C            EITHER
C                  ACTIVATE THE DESIRED SET OF DATA STATEMENTS BY
C                  REMOVING THE C FROM COLUMN 1
C            OR
C                  SET B, TD AND TS USING I1MACH BY ACTIVATING
C                  THE DECLARATION STATEMENTS FOR I1MACH
C                  AND THE STATEMENTS PRECEEDING THE FIRST
C                  EXECUTABLE STATEMENT BELOW.
C***END PROLOGUE  DPREC
*
C...LOCAL SCALARS
      DOUBLE PRECISION
     +   B
      INTEGER
     +   TD,TS
*
C...EXTERNAL FUNCTIONS
C     INTEGER
C    +   I1MACH
C     EXTERNAL
C    +   I1MACH
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
*
C     DOUBLE PRECISION B
C        THE BASE OF THE TARGET MACHINE.
C        (MAY BE DEFINED USING I1MACH(10).)
C     INTEGER TD
C        THE NUMBER OF BASE-B DIGITS IN DOUBLE PRECISION.
C        (MAY BE DEFINED USING I1MACH(14).)
C     INTEGER TS
C        THE NUMBER OF BASE-B DIGITS IN SINGLE PRECISION.
C        (MAY BE DEFINED USING I1MACH(11).)
*
*
C   MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM.
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  60 /
*
C   MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM
C                         THE BURROUGHS 6700/7700 SYSTEMS
C     DATA B  /   8 /
C     DATA TS /  13 /
C     DATA TD /  26 /
*
C   MACHINE CONSTANTS FOR THE CDC 6000/7000 (FTN5 COMPILER)
C                         THE CYBER 170/180 SERIES UNDER NOS
C     DATA B  /   2 /
C     DATA TS /  48 /
C     DATA TD /  96 /
*
C   MACHINE CONSTANTS FOR THE CDC 6000/7000 (FTN COMPILER)
C                         THE CYBER 170/180 SERIES UNDER NOS/VE
C                         THE CYBER 200 SERIES
C     DATA B  /   2 /
C     DATA TS /  47 /
C     DATA TD /  94 /
*
C   MACHINE CONSTANTS FOR THE CRAY 1
C     DATA B  /   2 /
C     DATA TS /  47 /
C     DATA TD /  94 /
*
C   MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE HARRIS COMPUTER
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  38 /
*
C   MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70
C                         THE HONEYWELL 600/6000 SERIES
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  63 /
*
C   MACHINE CONSTANTS FOR THE HP 2100
C      (3 WORD DOUBLE PRECISION OPTION WITH FTN4)
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  39 /
*
C   MACHINE CONSTANTS FOR THE HP 2100
C      (4 WORD DOUBLE PRECISION OPTION WITH FTN4)
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  55 /
*
C   MACHINE CONSTANTS FOR THE IBM 360/370 SERIES
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE IBM PC
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  53 /
*
C   MACHINE CONSTANTS FOR THE INTERDATA (PERKIN ELMER) 7/32
C                             INTERDATA (PERKIN ELMER) 8/32
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR).
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  54 /
*
C   MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR).
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  62 /
*
C   MACHINE CONSTANTS FOR THE PDP-11 SYSTEM
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  56 /
*
C   MACHINE CONSTANTS FOR THE PERKIN-ELMER 3230
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE PRIME 850 AND PRIME 4050
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  47 /
*
C   MACHINE CONSTANTS FOR THE SEL SYSTEMS 85/86
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR SUN 3
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  53 /
*
C   MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  60 /
*
C   MACHINE CONSTANTS FOR THE VAX-11 WITH FORTRAN IV-PLUS COMPILER
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  56 /
*
C   MACHINE CONSTANTS FOR THE VAX/VMS SYSTEM WITHOUT  G_FLOATING
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  56 /
*
C   MACHINE CONSTANTS FOR THE VAX/VMS SYSTEM WITH G_FLOATING
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  53 /
*
C   MACHINE CONSTANTS FOR THE XEROX SIGMA 5/7/9
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
*
C***FIRST EXECUTABLE STATEMENT  DMPREC
*
*
C     B = I1MACH(10)
C     TS = I1MACH(11)
C     TD = I1MACH(14)
*
      DMPREC = B ** (1-TD)
*
      RETURN
*
      END
*JAC
      SUBROUTINE JAC(N,NP,M,BETA,XPLUSD,LDXPD,
     +               FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOP)
C***BEGIN PROLOGUE  JAC
C***REFER TO  ?CODR,?CODRC
C***ROUTINES CALLED  NONE
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  DUMMY ROUTINE PROVIDED TO PREVENT OCCURANCE OF
C            UNSATISFIED EXTERNAL WHEN THE USER DOES NOT PROVIDE
C            SUBROUTINE JAC.
C***END PROLOGUE  JAC
*
C...SCALAR ARGUMENTS
C     INTEGER
C    +   ISTOP,LDFJB,LDFJX,LDXPD,M,N,NP
C     LOGICAL
C    +   ISODR
*
C...ARRAY ARGUMENTS
C     FLOATING POINT
C    +   BETA(NP),FJACB(LDFJB,NP),FJACX(LDFJX,M),XPLUSD(LDXPD,M)
*
C...INTRINSIC FUNCTIONS
C     INTRINSIC
C    +   EXP
*
*
C***FIRST EXECUTABLE STATEMENT  JAC
*
*
      PRINT *, ' **** ERROR ****'
      PRINT *, ' USER IS ATTEMPTING TO ACCESS A SUBROUTINE JAC',
     +         ' WHEN NONE HAS BEEN PROVIDED'
*
      ISTOP = -1
*
      RETURN
      END
*SACCES
      SUBROUTINE SACCES
     +   (N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +   ACCESS,
     +   JPVT,WRK1,TFJACB,OMEGA,YT,U,QRAUX,WRK2,
     +   NNZW,NPP,
     +   JOB,PARTOL,SSTOL,MAXIT,TAUFAC,EPSMAC,NETA,
     +   LUNRPT,IPR1,IPR2,IPR2F,IPR3,
     +   WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +   TAU,ALPHA,NITER,NFEV,NJEV,INT2,OLMAVG,
     +   RCOND,IRANK,ACTRS,PNORM,PRERS,RNORMS)
C***BEGIN PROLOGUE  SACCES
C***REFER TO SODR,SODRC
C***ROUTINES CALLED  SIWINF,SWINF
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  ACCESS OR STORE VALUES IN THE WORK ARRAYS
C***END PROLOGUE  SACESS
*
C...SCALAR ARGUMENTS
      REAL
     +   ACTRS,ALPHA,EPSMAC,OLMAVG,PARTOL,PNORM,PRERS,RCOND,
     +   RNORMS,RVAR,SSTOL,TAU,TAUFAC,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IDF,INT2,IPR1,IPR2,IPR2F,IPR3,IRANK,JOB,JPVT,LIWORK,LUNRPT,
     +   LWORK,M,MAXIT,N,NETA,NFEV,NITER,NJEV,NNZW,NP,NPP,OMEGA,
     +   QRAUX,TFJACB,U,WRK1,WRK2,YT
      LOGICAL
     +   ACCESS
*
C...ARRAY ARGUMENTS
      REAL
     +   WORK(LWORK)
      INTEGER
     +   IWORK(LIWORK)
*
C...LOCAL SCALARS
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSMAI,ETAI,FI,FJACBI,FJACXI,FNI,FSI,IDFI,INT2I,IPRINI,IPRINT,
     +   IRANKI,JOBI,JPVTI,LDTTI,LIWKMN,LUNERI,LUNRPI,LWKMN,MAXITI,
     +   MSGB,MSGX,NETAI,NFEVI,NITERI,NJEVI,NNZWI,NPPI,NROWI,NTOLI,
     +   OLMAVI,OMEGAI,PARTLI,PNORMI,PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,
     +   SI,SSFI,SSI,SSSI,SSTOLI,TAUFCI,TAUI,TFJACI,TI,TTI,UI,WRK1I,
     +   WRK2I,WSSI,WSSDEI,WSSEPI,XPLUSI,YTI
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SIWINF,SWINF
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL ACTRS
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER FI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER INT2
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPR1
C        THE VALUE OF THE FOURTH DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE INITIAL SUMMARY REPORT.
C     INTEGER IPR2
C        THE VALUE OF THE THIRD DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE ITERATION REPORTS.
C     INTEGER IPR2F
C        THE VALUE OF THE SECOND DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FREQUENCY OF THE ITERATION REPORTS.
C     INTEGER IPR3
C        THE VALUE OF THE FIRST DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FINAL SUMMARY REPORT.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVT
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY SJCK.
C     REAL OLMAVG
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGA
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     REAL PRERS
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUX
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     REAL RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     REAL RNORMS
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     REAL RVAR
C        THE RESIDUAL VARIANCE, I.E. STANDARD DEVIATION SQUARED.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE, I.E. STANDARD DEVIATION SQUARED.
C     REAL SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     REAL TAU
C        THE TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     INTEGER TFJACB
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER TFJACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     INTEGER U
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     REAL WORK(LWORK)
C        THE REAL WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     REAL WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     REAL WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     REAL WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     INTEGER YT
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     INTEGER YTI
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
*
*
C***FIRST EXECUTABLE STATEMENT  SACCES
*
*
C  FIND STARTING LOCATIONS WITHIN INTEGER WORKSPACE
*
      CALL SIWINF(M,NP,
     +            MSGB,MSGX,JPVTI,
     +            NNZWI,NPPI,IDFI,
     +            JOBI,IPRINI,LUNERI,LUNRPI,
     +            NROWI,NTOLI,NETAI,
     +            MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +            LIWKMN)
*
C  FIND STARTING LOCATIONS WITHIN REAL WORK SPACE
*
      CALL SWINF(N,M,NP,
     +           DELTAI,FI,
     +           WSSI,WSSDEI,WSSEPI,RVARI,
     +           PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +           FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +           DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +           ALPHAI,TFJACI,OMEGAI,YTI,UI,QRAUXI,WRK1I,WRK2I,RCONDI,
     +           ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +           LWKMN)
*
      IF (ACCESS) THEN
*
C  SET STARTING LOCATIONS FOR WORK VECTORS
*
         JPVT   = JPVTI
         WRK1   = WRK1I
         TFJACB = TFJACI
         OMEGA  = OMEGAI
         YT     = YTI
         U      = UI
         QRAUX  = QRAUXI
         WRK2   = WRK2I
*
C  ACCESS VALUES FROM THE WORK VECTORS
*
         ACTRS  = WORK(ACTRSI)
         ALPHA  = WORK(ALPHAI)
         EPSMAC = WORK(EPSMAI)
         OLMAVG = WORK(OLMAVI)
         PARTOL = WORK(PARTLI)
         PNORM  = WORK(PNORMI)
         PRERS  = WORK(PRERSI)
         RCOND  = WORK(RCONDI)
         WSS    = WORK(WSSI)
         WSSDEL = WORK(WSSDEI)
         WSSEPS = WORK(WSSEPI)
         RVAR   = WORK(RVARI)
         RNORMS = WORK(RNORSI)
         SSTOL  = WORK(SSTOLI)
         TAU    = WORK(TAUI)
         TAUFAC = WORK(TAUFCI)
*
         NETA   = IWORK(NETAI)
         IRANK  = IWORK(IRANKI)
         JOB    = IWORK(JOBI)
         LUNRPT = IWORK(LUNRPI)
         MAXIT  = IWORK(MAXITI)
         NFEV   = IWORK(NFEVI)
         NITER  = IWORK(NITERI)
         NJEV   = IWORK(NJEVI)
         NNZW   = IWORK(NNZWI)
         NPP    = IWORK(NPPI)
         IDF    = IWORK(IDFI)
         INT2   = IWORK(INT2I)
*
C  SET UP PRINT CONTROL VARIABLES
*
         IPRINT = IWORK(IPRINI)
*
         IPR1   = MOD(IPRINT,10000)/1000
         IPR2   = MOD(IPRINT,1000)/100
         IPR2F  = MOD(IPRINT,100)/10
         IPR3   = MOD(IPRINT,10)
*
      ELSE
*
C  STORE VALUES INTO THE WORK VECTORS
*
         WORK(ACTRSI)  = ACTRS
         WORK(ALPHAI)  = ALPHA
         WORK(OLMAVI)  = OLMAVG
         WORK(PARTLI)  = PARTOL
         WORK(PNORMI)  = PNORM
         WORK(PRERSI)  = PRERS
         WORK(RCONDI)  = RCOND
         WORK(WSSI)    = WSS
         WORK(WSSDEI)  = WSSDEL
         WORK(WSSEPI)  = WSSEPS
         WORK(RVARI)   = RVAR
         WORK(RNORSI)  = RNORMS
         WORK(SSTOLI)  = SSTOL
         WORK(TAUI)    = TAU
*
         IWORK(IRANKI) = IRANK
         IWORK(NFEVI)  = NFEV
         IWORK(NITERI) = NITER
         IWORK(NJEVI)  = NJEV
         IWORK(IDFI)   = IDF
         IWORK(INT2I)  = INT2
      END IF
*
      RETURN
      END
*SDIAGI
      SUBROUTINE SDIAGI
     +   (N,M,S,LDS,V,LDV,SV,LDSV)
C***BEGIN PROLOGUE  SDIAGI
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE THE VECTOR V BY THE INVERSE OF THE DIAGONAL MATRIX S
C            AND RETURN THE RESULT IN VECTOR SV
C***END PROLOGUE  SDIAGI
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDS,LDSV,LDV,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   S(LDS,M),SV(LDSV,M),V(LDV,M)
*
C...LOCAL SCALARS
      REAL
     +   ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDS
C        THE LEADING DIMENSION OF ARRAY S.
C     INTEGER LDSV
C        THE LEADING DIMENSION OF ARRAY SV.
C     INTEGER LDV
C        THE LEADING DIMENSION OF ARRAY V.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL S(LDS,M)
C        THE SCALING ARRAY.
C     REAL SV(LDSV,M)
C        THE INVERSE SCALED ARRAY.
C     REAL V(LDV,M)
C        THE ARRAY BEING SCALED.
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SDIAGI
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (S(1,1).LT.ZERO) THEN
         DO 20 J=1,M
            DO 10 I = 1,N
               SV(I,J) = V(I,J)/ABS(S(1,1))
   10       CONTINUE
   20    CONTINUE
      ELSE
         IF (LDS.EQ.1) THEN
            DO 40 J=1,M
               DO 30 I=1,N
                  SV(I,J) = V(I,J)/S(1,J)
   30          CONTINUE
   40       CONTINUE
         ELSE
            DO 60 J=1,M
               DO 50 I=1,N
                  SV(I,J) = V(I,J)/S(I,J)
   50          CONTINUE
   60       CONTINUE
         END IF
      END IF
*
      RETURN
      END
*SDIAGS
      SUBROUTINE SDIAGS
     +   (N,M,S,LDS,V,LDV,SV,LDSV)
C***BEGIN PROLOGUE  SDIAGS
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE THE VECTOR V BY THE DIAGONAL MATRIX S
C            AND RETURN THE RESULT IN VECTOR SV.
C***END PROLOGUE  SDIAGS
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDS,LDSV,LDV,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   S(LDS,M),SV(LDSV,M),V(LDV,M)
*
C...LOCAL SCALARS
      REAL
     +   ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDS
C        THE LEADING DIMENSION OF ARRAY S.
C     INTEGER LDSV
C        THE LEADING DIMENSION OF ARRAY SV.
C     INTEGER LDV
C        THE LEADING DIMENSION OF ARRAY V.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL S(LDS,M)
C        THE SCALING ARRAY.
C     REAL SV(LDSV,M)
C        THE SCALED ARRAY.
C     REAL V(LDV,M)
C        THE ARRAY BEING SCALED.
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SDIAGS
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (S(1,1).LT.ZERO) THEN
         DO 20 J=1,M
            DO 10 I=1,N
               SV(I,J) = ABS(S(1,1))*V(I,J)
   10       CONTINUE
   20    CONTINUE
      ELSE
         IF (LDS.EQ.1) THEN
            DO 40 J=1,M
               DO 30 I=1,N
                  SV(I,J) = S(1,J)*V(I,J)
   30          CONTINUE
   40       CONTINUE
         ELSE
            DO 60 J=1,M
               DO 50 I=1,N
                  SV(I,J) = S(I,J)*V(I,J)
   50          CONTINUE
   60       CONTINUE
         END IF
      END IF
*
      RETURN
      END
*SDIAGW
      SUBROUTINE SDIAGW
     +   (N,M,W,V,LDV,WV,LDWV)
C***BEGIN PROLOGUE  SDIAGW
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE THE N BY M ARRAY V BY THE DIAGONAL OBSERVATIONAL
C            ERROR WEIGHT MATRIX W AND RETURN THE RESULT IN VECTOR WV.
C            N.B.  IF THE FIRST ELEMENT OF W IS NEGATIVE, THE DEFAULT
C            WEIGHTING OF ONE FOR ALL ELEMENTS WILL BE INVOKED, I.E.,
C            THE RESULTS WILL BE "UNWEIGHTED."
C***END PROLOGUE  SDIAGW
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDV,LDWV,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   V(LDV,M),W(N),WV(LDWV,M)
*
C...LOCAL SCALARS
      REAL
     +   ZERO
      INTEGER
     +   I,J
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDV
C        THE LEADING DIMENSION OF ARRAY V.
C     INTEGER LDWV
C        THE LEADING DIMENSION OF ARRAY WV.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL V(LDV,M)
C        THE ARRAY BEING WEIGHTED.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C     REAL WV(LDWV,M)
C        THE WEIGHTED ARRAY.
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SDIAGW
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (W(1).LT.ZERO) THEN
         DO 20 J=1,M
            DO 10 I=1,N
               WV(I,J) = V(I,J)
   10       CONTINUE
   20    CONTINUE
      ELSE
         DO 40 J=1,M
            DO 30 I=1,N
               WV(I,J) = W(I)*V(I,J)
   30       CONTINUE
   40    CONTINUE
      END IF
*
      RETURN
      END
*SETAF
      SUBROUTINE SETAF
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,NETA,EPSMAC,
     +   NROW,PARTMP,PVTEMP,ISTOP)
C***BEGIN PROLOGUE  SETAF
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE NOISE AND NUMBER OF GOOD DIGITS IN FUNCTION RESULTS
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE ETAFUN)
C***END PROLOGUE  SETAF
*
C...SCALAR ARGUMENTS
      REAL
     +   EPSMAC,ETA
      INTEGER
     +   ISTOP,LDXPD,M,N,NETA,NFEV,NP,NROW
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),PARTMP(NP),PVTEMP(N),XPLUSD(LDXPD,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   A,B,FAC,J,ONE,P1,P2,RSSSM,RSSSMJ,SQRTMP,ZERO
      INTEGER
     +   I,K
*
C...LOCAL ARRAYS
      REAL
     +   RSS(5)
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,INT,LOG10,MAX,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P1,P2,ONE
     +   /0.0E0,0.1E0,0.2E0,1.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL A
C        PARAMETERS OF THE FIT.
C     REAL B
C        PARAMETERS OF THE FIT.
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL ETA
C        THE NOISE IN THE MODEL RESULTS.
C     REAL FAC
C        A FACTOR USED IN THE COMPUTATIONS.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     REAL J
C        THE VALUE FLOAT(I-3).
C     INTEGER K
C        AN INDEX VARIABLE.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE MODEL RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL P1
C        THE VALUE 0.1E0.
C     REAL P2
C        THE VALUE 0.2E0.
C     REAL PARTMP(NP)
C        MODIFIED MODEL PARAMETERS
C     REAL PVTEMP(N)
C        PREDICTED VALUES
C     REAL RSS(5)
C        THE RESIDUAL SUM OF SQUARES FOR EACH VALUE OF J.
C     REAL RSSSM
C        THE SUM OF THE RESIDUAL SUM OF SQUARES FOR EACH SET OF
C        PARAMETER VALUES.
C     REAL RSSSMJ
C        THE SUM OF THE RESIDUAL SUM OF SQUARES TIMES J FOR EACH
C        SET OF PARAMETER VALUES.
C     REAL SQRTMP
C        THE SQUARE ROOT OF MACHINE PRECISION (EPSMAC).
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SETAF
*
*
      SQRTMP = SQRT(EPSMAC)
      RSSSM = ZERO
      RSSSMJ = ZERO
      DO 20 I=1,5
         J = I-3
         DO 10 K=1,NP
            PARTMP(K) = BETA(K)*(ONE+J*SQRTMP)
   10    CONTINUE
         ISTOP = 0
         CALL FUN(N,NP,M,PARTMP,XPLUSD,LDXPD,PVTEMP,ISTOP)
         NFEV = NFEV + 1
         IF (ISTOP.NE.0) THEN
            RETURN
         END IF
*
         RSS(I) = PVTEMP(NROW)
*
         RSSSM = RSSSM + RSS(I)
         RSSSMJ = RSSSMJ + J*RSS(I)
   20 CONTINUE
      A = P2*RSSSM
      B = P1*RSSSMJ
      IF (RSS(3).NE.ZERO) THEN
         FAC = ONE/ABS(RSS(3))
      ELSE
         FAC = ONE
      END IF
      DO 30 I=1,5
         J = I-3
         RSS(I) = ABS((RSS(I)-(A+J*B))*FAC)
   30 CONTINUE
      ETA = MAX(RSS(1),RSS(2),RSS(3),RSS(4),RSS(5),EPSMAC)
      NETA = INT(-LOG10(ETA))
*
      RETURN
      END
*SEVFUN
      SUBROUTINE SEVFUN
     +   (N,NP,M,BETAC,BETA,IFIXB,FUN,
     +   X,LDX,Y,DELTA,LDDELT,XPLUSD,LDXPD,
     +   W,F,NFEV,ISTOP)
C***BEGIN PROLOGUE  SEVFUN
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SAXPY,SDIAGW,SUNPAC,SXPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE THE WEIGHTED EPSILON'S FOR THE CURRENT POINT
C***END PROLOGUE  SEVFUN
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOP,LDDELT,LDX,LDXPD,M,N,NFEV,NP
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),BETAC(NP),DELTA(LDDELT,M),F(N),W(N),
     +   X(LDX,M),XPLUSD(LDXPD,M),Y(N)
      INTEGER
     +   IFIXB(NP)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   NEGONE
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SAXPY,SDIAGW,SUNPAC,SXPY
*
C...DATA STATEMENTS
      DATA
     +   NEGONE
     +   /-1.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL BETAC(NP)
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     REAL DELTA(LDDELT,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     REAL F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     INTEGER LDDELT
C        THE LEADING DIMENSION OF ARRAY DELTA.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL NEGONE
C        THE VALUE -1.0E0.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  SEVFUN
*
*
C  INSERT CURRENT UNFIXED BETA ESTIMATES INTO BETA
*
      CALL SUNPAC(NP,BETAC,BETA,IFIXB)
*
C  COMPUTE XPLUSD = X + DELTA
*
      CALL SXPY(N,M,X,LDX,DELTA,LDDELT,XPLUSD,LDXPD)
*
C  EVALUATE THE PREDICTED VALUES OF THE FUNCTION FOR THE CURRENT POINT
*
      ISTOP = 1
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,F,ISTOP)
      IF (ISTOP.LT.0) THEN
         RETURN
      END IF
*
C  INCREMENT COUNT OF NUMBER OF FUNCTION EVALUATIONS
*
      NFEV = NFEV + 1
*
C  COMPUTE WEIGHTED EPSILONS FOR CURRENT POINT AND STORE IN F
*
      CALL SAXPY(N,NEGONE,Y,1,F,1)
      CALL SDIAGW(N,1,W,F,N,F,N)
*
      RETURN
      END
*SEVJAC
      SUBROUTINE SEVJAC
     +   (FUN,JAC,ANAJAC,
     +   N,NP,NPP,M,BETAC,BETA,IFIXB,IFIXX,LDIFX,
     +   X,LDX,DELTA,LDDELT,XPLUSD,LDXPD,
     +   SS,TT,LDTT,NETA,PV,STP,
     +   FJACB,LDFJB,ISODR,FJACX,LDFJX,W,NJEV,NFEV,ISTOP)
C***BEGIN PROLOGUE  SEVJAC
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SDIAGW,SJACFD,SUNPAC,SXPY,SZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE THE WEIGHTED JACOBIANS WRT BETA AND DELTA
C***END PROLOGUE  SEVJAC
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOP,LDDELT,LDFJB,LDFJX,LDIFX,LDTT,LDX,LDXPD,M,N,NETA,NFEV,
     +   NJEV,NP,NPP
      LOGICAL
     +   ANAJAC,ISODR
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),BETAC(NP),DELTA(LDDELT,M),
     +   FJACB(LDFJB,NP),FJACX(LDFJX,M),PV(N),SS(NP),
     +   STP(N),TT(LDTT,M),W(N),X(LDX,M),XPLUSD(LDXPD,M)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      REAL
     +   ZERO
      INTEGER
     +   I,J,JFX
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SDIAGW,SJACFD,SUNPAC,SXPY,SZERO
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL BETAC(NP)
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     REAL DELTA(LDDELT,M)
C        THE ESTIMATED VALUES OF DELTA.
C     REAL FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     REAL FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JFX
C        AN INDEXING VARIABLE.
C     INTEGER LDDELT
C        THE LEADING DIMENSION OF ARRAY DELTA.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL PV(N)
C        THE PREDICTED VALUES OF THE FUNCTION AT THE CURRENT
C        POINT.
C     REAL SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL STP(N)
C        THE STEP USED TO COMPUTE FINITE DIFFERENCE DERIVATIVES.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SEVJAC
*
*
C  INSERT CURRENT UNFIXED BETA ESTIMATES INTO BETA
*
      CALL SUNPAC(NP,BETAC,BETA,IFIXB)
*
C  COMPUTE XPLUSD = X + DELTA
*
      CALL SXPY(N,M,X,LDX,DELTA,LDDELT,XPLUSD,LDXPD)
*
C  COMPUTE THE JACOBIAN WRT THE ESTIMATED BETAS (FJACB) AND
C          THE JACOBIAN WRT DELTA (FJACX)
*
      ISTOP = 1
      IF (ANAJAC) THEN
         CALL JAC(N,NP,M,BETA,XPLUSD,LDXPD,
     +            FJACB,LDFJB,ISODR,FJACX,LDFJX,ISTOP)
         NJEV = NJEV+1
      ELSE
         CALL SJACFD(N,NP,M,BETA,
     +               X,LDX,DELTA,XPLUSD,LDXPD,FUN,
     +               SS,TT,LDTT,NETA,PV,STP,
     +               IFIXB,FJACB,LDFJB,ISODR,
     +               IFIXX,LDIFX,FJACX,LDFJX,NFEV,ISTOP)
      END IF
      IF (ISTOP.LT.0) THEN
         RETURN
      END IF
*
C  WEIGHT THE JACOBIAN WRT THE ESTIMATED BETAS
*
      IF (ANAJAC) THEN
         JFX = 0
         IF (IFIXB(1).GE.0) THEN
            DO 10 J=1,NP
               IF (IFIXB(J).NE.0) THEN
                  JFX = JFX + 1
                  CALL SDIAGW(N,1,W,FJACB(1,J),LDFJB,
     +                        FJACB(1,JFX),LDFJB)
               END IF
   10       CONTINUE
         ELSE
            DO 20 J=1,NP
               CALL SDIAGW(N,1,W,FJACB(1,J),LDFJB,
     +                     FJACB(1,J),LDFJB)
   20       CONTINUE
         END IF
      ELSE
         DO 30 J=1,NPP
            CALL SDIAGW(N,1,W,FJACB(1,J),LDFJB,
     +                  FJACB(1,J),LDFJB)
   30    CONTINUE
      END IF
*
C  WEIGHT OR ZERO THE JACOBIAN'S WRT X AS APPROPRIATE
*
      IF (ISODR) THEN
         IF (IFIXX(1,1).GE.0) THEN
*
C  CHECK FOR POSSIBLY FIXED COLUMNS OR ELEMENTS OF X
*
            IF (LDIFX.EQ.1) THEN
               DO 40 J=1,M
                  IF (IFIXX(1,J).EQ.0) THEN
*
C  ZERO JACOBIAN WRT X(I,J) FOR I=1,N
*
                     CALL SZERO(N,1,FJACX(1,J),LDFJX)
                  ELSE
*
C  WEIGHT JACOBIAN WRT X(I,J) FOR I=1,N
*
                     CALL SDIAGW(N,1,W,FJACX(1,J),LDFJX,
     +                           FJACX(1,J),LDFJX)
                  END IF
   40          CONTINUE
            ELSE
*
C  WEIGHT JACOBIAN WRT X(I,J) FOR I=1,N AND
C  THEN ZERO APPROPRIATE ELEMENTS
*
               DO 60 J=1,M
                  CALL SDIAGW(N,1,W,FJACX(1,J),LDFJX,
     +                        FJACX(1,J),LDFJX)
                  DO 50 I=1,N
                     IF (IFIXX(I,J).EQ.0) THEN
                        FJACX(I,J) = ZERO
                     END IF
   50             CONTINUE
   60          CONTINUE
            END IF
         ELSE
*
C  WEIGHT JACOBIAN WRT X(I,J) FOR I=1,N AND J=1,M
*
            DO 70 J=1,M
               CALL SDIAGW(N,1,W,FJACX(1,J),LDFJX,
     +                     FJACX(1,J),LDFJX)
   70       CONTINUE
         END IF
      ELSE
*
C  ZERO ALL ELEMENTS OF FJACX FOR OLS FIT
*
         CALL SZERO(N,M,FJACX,LDFJX)
      END IF
*
      RETURN
      END
*SFLAGS
      SUBROUTINE SFLAGS
     +   (JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
C***BEGIN PROLOGUE  SFLAGS
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET FLAGS INDICATING CONDITIONS SPECIFIED BY JOB
C***END PROLOGUE  SFLAGS
*
C...SCALAR ARGUMENTS
      INTEGER
     +   JOB
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...LOCAL SCALARS
      INTEGER
     +   J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        THE VALUE OF THE SECOND DIGIT (FROM THE RIGHT) OF JOB.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
*
*
C***FIRST EXECUTABLE STATEMENT  SFLAGS
*
*
      IF (JOB.GE.0) THEN
         RESTRT= JOB.GE.10000
         INITD = MOD(JOB,10000)/1000.EQ.0
         DOVCV = MOD(JOB,1000)/100.EQ.0
         J = MOD(JOB,100)/10
         IF (J.EQ.0) THEN
            ANAJAC = .FALSE.
            CHKJAC = .FALSE.
         ELSE IF (J.EQ.1) THEN
            ANAJAC = .TRUE.
            CHKJAC = .TRUE.
         ELSE
            ANAJAC = .TRUE.
            CHKJAC = .FALSE.
         END IF
         ISODR = MOD(JOB,10).EQ.0
      ELSE
         RESTRT  = .FALSE.
         INITD = .TRUE.
         DOVCV = .TRUE.
         ANAJAC = .FALSE.
         CHKJAC = .FALSE.
         ISODR = .TRUE.
      END IF
*
      RETURN
      END
*SIDTS
      SUBROUTINE SIDTS
     +   (N,M,W,WD,LDWD,ALPHA,TT,LDTT,T,LDT,DTT,LDDTT)
C***BEGIN PROLOGUE  SIDTS
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE MATRIX TT BY THE INVERSE OF DT, I.E., COMPUTE
C            DTT = T * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2,
C            W AND D ARE DEFINED BY EQ.2 OF THE PROLOGUE OF SODR
C            AND SODRC, AND TT IS THE SCALING MATRIX FOR THE DELTA'S,
C            ALSO DEFINED IN THE PROLOGUE OF SODR AND SODRC.
C***END PROLOGUE  SIDTS
*
C...SCALAR ARGUMENTS
      REAL
     +   ALPHA
      INTEGER
     +   LDDTT,LDT,LDTT,LDWD,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   DTT(LDDTT,M),T(LDT,M),TT(LDTT,M),W(N),WD(LDWD,M)
*
C...LOCAL SCALARS
      REAL
     +   DT,ONE,TERM1,TERM2,ZERO
      INTEGER
     +   I,J
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0E0,1.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C   N.B. THE LOCATIONS OF W, WD AND TT ACCESSED DEPEND ON THE VALUE
C        OF THE FIRST ELEMENT OF EACH ARRAY AND THE LEADING DIMENSION
C        OF THE DOUBLY SUBSCRIPTED ARRAYS.
C     REAL ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     REAL DT
C        THE VALUE OF THE FACTOR DT = INV((W*D)**2+ALPHA*TT**2)
C     REAL DTT(LDDTT,M)
C        THE ARRAY DTT = T * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDDTT
C        THE LEADING DIMENSION OF ARRAY DTT.
C     INTEGER LDT
C        THE LEADING DIMENSION OF ARRAY T.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL T(LDT,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     REAL TERM1
C        THE VALUE OF THE TERM (W(I)*WD(I,J))**2
C     REAL TERM2
C        THE VALUE OF THE TERM ALPHA*TT(I,J)**2
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SIDTS
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (W(1).GE.ZERO) THEN
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 1120 J=1,M
                        DO 1110 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(I,J))**2 +
     +                                   ALPHA*TT(I,J)**2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1110                   CONTINUE
 1120                CONTINUE
                  ELSE
                     DO 1140 J=1,M
                        TERM2 = ALPHA*TT(1,J)**2
                        DO 1130 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(I,J))**2+TERM2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1130                   CONTINUE
 1140                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 1160 J=1,M
                     DO 1150 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/((W(I)*WD(I,J))**2+TERM2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1150                CONTINUE
 1160             CONTINUE
               END IF
            ELSE
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 1220 J=1,M
                        DO 1210 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(1,J))**2 +
     +                                   ALPHA*TT(I,J)**2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1210                   CONTINUE
 1220                CONTINUE
                  ELSE
                     DO 1240 J=1,M
                        TERM2 = ALPHA*TT(1,J)**2
                        DO 1230 I=1,N
                           IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                              DTT(I,J) = T(I,J)/
     +                                   ((W(I)*WD(1,J))**2+TERM2)
                           ELSE
                              DTT(I,J) = ZERO
                           END IF
 1230                   CONTINUE
 1240                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 1260 J=1,M
                     DO 1250 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/((W(I)*WD(1,J))**2+TERM2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1250                CONTINUE
 1260             CONTINUE
               END IF
            END IF
         ELSE
            IF (TT(1,1).GT.ZERO) THEN
               IF (LDTT.GE.N) THEN
                  DO 1320 J=1,M
                     DO 1310 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/
     +                                ((W(I)*WD(1,1))**2 +
     +                                ALPHA*TT(I,J)**2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1310                CONTINUE
 1320             CONTINUE
               ELSE
                  DO 1340 J=1,M
                     TERM2 = ALPHA*TT(1,J)**2
                     DO 1330 I=1,N
                        IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                           DTT(I,J) = T(I,J)/((W(I)*WD(1,1))**2+TERM2)
                        ELSE
                           DTT(I,J) = ZERO
                        END IF
 1330                CONTINUE
 1340             CONTINUE
               END IF
            ELSE
               TERM2 = ALPHA*TT(1,1)**2
               DO 1360 J=1,M
                  DO 1350 I=1,N
                     IF (W(I).NE.ZERO .OR. ALPHA.NE.ZERO) THEN
                        DTT(I,J) = T(I,J)/((W(I)*WD(1,1))**2+TERM2)
                     ELSE
                        DTT(I,J) = ZERO
                     END IF
 1350             CONTINUE
 1360          CONTINUE
            END IF
         END IF
      ELSE
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 2120 J=1,M
                        DO 2110 I=1,N
                           DTT(I,J) = T(I,J)/
     +                                (WD(I,J)**2 + ALPHA*TT(I,J)**2)
 2110                   CONTINUE
 2120                CONTINUE
                  ELSE
                     DO 2140 J=1,M
                        TERM2 = ALPHA*TT(1,J)**2
                        DO 2130 I=1,N
                           DTT(I,J) = T(I,J)/(WD(I,J)**2+TERM2)
 2130                   CONTINUE
 2140                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 2160 J=1,M
                     DO 2150 I=1,N
                        DTT(I,J) = T(I,J)/(WD(I,J)**2+TERM2)
 2150                CONTINUE
 2160             CONTINUE
               END IF
            ELSE
               IF (TT(1,1).GT.ZERO) THEN
                  IF (LDTT.GE.N) THEN
                     DO 2220 J=1,M
                        TERM1 = WD(1,J)**2
                        DO 2210 I=1,N
                           DTT(I,J) = T(I,J)/(TERM1+ALPHA*TT(I,J)**2)
 2210                   CONTINUE
 2220                CONTINUE
                  ELSE
                     DO 2240 J=1,M
                        DT = ONE/(WD(1,J)**2+ALPHA*TT(1,J)**2)
                        DO 2230 I=1,N
                           DTT(I,J) = T(I,J)*DT
 2230                   CONTINUE
 2240                CONTINUE
                  END IF
               ELSE
                  TERM2 = ALPHA*TT(1,1)**2
                  DO 2260 J=1,M
                     TERM1 = WD(1,J)**2
                     DT = ONE/(TERM1+TERM2)
                     DO 2250 I=1,N
                        DTT(I,J) = T(I,J)*DT
 2250                CONTINUE
 2260             CONTINUE
               END IF
            END IF
         ELSE
            IF (TT(1,1).GT.ZERO) THEN
               IF (LDTT.GE.N) THEN
                  TERM1 = WD(1,1)**2
                  DO 2320 J=1,M
                     DO 2310 I=1,N
                        DTT(I,J) = T(I,J)/(TERM1 + ALPHA*TT(I,J)**2)
 2310                CONTINUE
 2320             CONTINUE
               ELSE
                  TERM1 = WD(1,1)**2
                  DO 2340 J=1,M
                     TERM2 = ALPHA*TT(1,J)**2
                     DT = ONE/(TERM1+TERM2)
                     DO 2330 I=1,N
                        DTT(I,J) = T(I,J)*DT
 2330                CONTINUE
 2340             CONTINUE
               END IF
            ELSE
               DT = ONE/(WD(1,1)**2+ALPHA*TT(1,1)**2)
               DO 2360 J=1,M
                  DO 2350 I=1,N
                     DTT(I,J) = T(I,J)*DT
 2350             CONTINUE
 2360          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
      END
*SINIWK
      SUBROUTINE SINIWK
     +   (N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   BETA,SCLB,
     +   SSTOL,PARTOL,MAXIT,TAUFAC,
     +   JOB,IPRINT,LUNERR,LUNRPT,
     +   EPSMAI,SSTOLI,PARTLI,MAXITI,TAUFCI,
     +   JOBI,IPRINI,LUNERI,LUNRPI,
     +   SSFI,TTI,LDTTI,DELTAI)
C***BEGIN PROLOGUE  SINIWK
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SFLAGS,SMPREC,SSCLB,SSCLD,SZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  INITIALIZE WORK VECTORS AS NECESSARY
C***END PROLOGUE  SINIWK
*
C...SCALAR ARGUMENTS
      REAL
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   DELTAI,EPSMAI,IPRINI,IPRINT,JOB,JOBI,LDIFX,
     +   LDSCLD,LDTTI,LDX,LIWORK,LUNERI,LUNERR,LUNRPI,LUNRPT,LWORK,M,
     +   MAXIT,MAXITI,N,NP,PARTLI,SSFI,SSTOLI,TAUFCI,TTI
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),SCLB(NP),SCLD(LDSCLD,M),WORK(LWORK),X(LDX,M)
      INTEGER
     +   IFIXX(LDIFX,M),IWORK(LIWORK)
*
C...LOCAL SCALARS
      REAL
     +   ONE,THREE,TWO,ZERO
      INTEGER
     +   I,J
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SMPREC
      EXTERNAL
     +   SMPREC
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SCOPY,SFLAGS,SSCLB,SSCLD,SZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TWO,THREE
     +   /0.0E0,1.0E0,2.0E0,3.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     INTEGER EPSMAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTTI
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ONE
C        THE VALUE 1.0E0.
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     REAL SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     REAL THREE
C          THE VALUE 3.0E0.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     REAL TWO
C          THE VALUE 2.0E0.
C     REAL WORK(LWORK)
C        THE REAL WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SINIWK
*
*
      CALL SFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
*
C  STORE VALUE OF MACHINE PRECISION IN WORK VECTOR
*
      WORK(EPSMAI) = SMPREC()
*
C  SET TOLERANCE FOR STOPPING CRITERIA BASED ON THE CHANGE IN THE
C  PARAMETERS
*
      IF (PARTOL.LT.WORK(EPSMAI) .OR. PARTOL.GE.ONE) THEN
         WORK(PARTLI) = WORK(EPSMAI)**(TWO/THREE)
      ELSE
         WORK(PARTLI) = PARTOL
      END IF
*
C  SET TOLERANCE FOR STOPPING CRITERIA BASED ON THE CHANGE IN THE
C  SUM OF SQUARES OF THE WEIGHTED OBSERVATIONAL ERRORS
*
      IF (SSTOL.LT.WORK(EPSMAI) .OR. SSTOL.GE.ONE) THEN
         WORK(SSTOLI) = SQRT(WORK(EPSMAI))
      ELSE
         WORK(SSTOLI) = SSTOL
      END IF
*
C  SET FACTOR FOR COMPUTING TRUST REGION DIAMETER AT FIRST ITERATION
*
      IF (TAUFAC.LE.ZERO) THEN
         WORK(TAUFCI) = ONE
      ELSE
         WORK(TAUFCI) = TAUFAC
      END IF
*
C  SET MAXIMUM NUMBER OF ITERATIONS
*
      IF (MAXIT.LE.0) THEN
         IWORK(MAXITI) = 50
      ELSE
         IWORK(MAXITI) = MAXIT
      END IF
*
C  STORE PROBLEM INITIALIZATION AND COMPUTATIONAL METHOD CONTROL
C  VARIABLE
*
      IF (JOB.LE.0) THEN
         IWORK(JOBI) = 0
      ELSE
         IWORK(JOBI) = JOB
      END IF
*
C  SET PRINT CONTROL
*
      IF (IPRINT.LT.0) THEN
         IWORK(IPRINI) = 2001
      ELSE
         IWORK(IPRINI) = IPRINT
      END IF
*
C  SET LOGICAL UNIT NUMBER FOR ERROR MESSAGES
*
      IF (LUNERR.LT.0) THEN
         IWORK(LUNERI) = 6
      ELSE
         IWORK(LUNERI) = LUNERR
      END IF
*
C  SET LOGICAL UNIT NUMBER FOR COMPUTATION REPORTS
*
      IF (LUNRPT.LT.0) THEN
         IWORK(LUNRPI) = 6
      ELSE
         IWORK(LUNRPI) = LUNRPT
      END IF
*
C  COMPUTE SCALING FOR BETA'S AND DELTA'S
*
      IF (SCLB(1).LE.ZERO) THEN
         CALL SSCLB(NP,BETA,WORK(SSFI))
      ELSE
         CALL SCOPY(NP,SCLB,1,WORK(SSFI),1)
      END IF
      IF (SCLD(1,1).LE.ZERO) THEN
         IWORK(LDTTI) = N
         CALL SSCLD(N,M,X,LDX,WORK(TTI),IWORK(LDTTI))
      ELSE
         IF (LDSCLD.EQ.1) THEN
            IWORK(LDTTI) = 1
            CALL SCOPY(N,SCLD(1,1),1,WORK(TTI),1)
         ELSE
            IWORK(LDTTI) = N
            DO 10 J=1,M
               CALL SCOPY(N,SCLD(1,J),1,WORK(TTI+(J-1)*IWORK(LDTTI)),1)
   10       CONTINUE
         END IF
      END IF
*
C  INITIALIZE DELTA'S AS NECESSARY
*
      IF (ISODR) THEN
         IF (INITD) THEN
            CALL SZERO(N,M,WORK(DELTAI),N)
         ELSE
            IF (IFIXX(1,1).GE.0) THEN
               IF (LDIFX.EQ.1) THEN
                  DO 20 J=1,M
                     IF (IFIXX(1,J).EQ.0) THEN
                        CALL SZERO(N,1,WORK(DELTAI+(J-1)*N),N)
                     END IF
   20             CONTINUE
               ELSE
                  DO 40 J=1,M
                     DO 30 I=1,N
                        IF (IFIXX(I,J).EQ.0) THEN
                           WORK(DELTAI-1+I+(J-1)*N) = ZERO
                        END IF
   30                CONTINUE
   40             CONTINUE
               END IF
            END IF
         END IF
      ELSE
         CALL SZERO(N,M,WORK(DELTAI),N)
      END IF
*
      RETURN
      END
*SIWINF
      SUBROUTINE SIWINF
     +   (M,NP,
     +   MSGB,MSGX,JPVTI,
     +   NNZWI,NPPI,IDFI,
     +   JOBI,IPRINI,LUNERI,LUNRPI,
     +   NROWI,NTOLI,NETAI,
     +   MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +   LIWKMN)
C***BEGIN PROLOGUE  SIWINF
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET STORAGE LOCATIONS WITHIN INTEGER WORK SPACE
C***END PROLOGUE  SIWINF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   IDFI,INT2I,IPRINI,IRANKI,JOBI,JPVTI,LDTTI,LIWKMN,LUNERI,
     +   LUNRPI,M,MAXITI,MSGB,MSGX,NETAI,NFEVI,NITERI,NJEVI,NNZWI,NP,
     +   NPPI,NROWI,NTOLI
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY SJCK.
*
*
C***FIRST EXECUTABLE STATEMENT  SIWINF
*
*
      IF (NP.GE.1 .AND. M.GE.1) THEN
         MSGB   = 1
         MSGX   = MSGB   + NP+1
         JPVTI  = MSGX   + M+1
         NNZWI  = JPVTI  + NP
         NPPI   = NNZWI  + 1
         IDFI   = NPPI  + 1
         JOBI   = IDFI   + 1
         IPRINI = JOBI   + 1
         LUNERI = IPRINI + 1
         LUNRPI = LUNERI + 1
         NROWI  = LUNRPI + 1
         NTOLI  = NROWI  + 1
         NETAI  = NTOLI  + 1
         MAXITI = NETAI  + 1
         NITERI = MAXITI + 1
         NFEVI  = NITERI + 1
         NJEVI  = NFEVI  + 1
         INT2I  = NJEVI  + 1
         IRANKI = INT2I  + 1
         LDTTI  = IRANKI + 1
         LIWKMN = LDTTI
      ELSE
         MSGB   = 1
         MSGX   = 1
         JPVTI  = 1
         NNZWI  = 1
         NPPI   = 1
         IDFI   = 1
         JOBI   = 1
         IPRINI = 1
         LUNERI = 1
         LUNRPI = 1
         NROWI  = 1
         NTOLI  = 1
         NETAI  = 1
         MAXITI = 1
         NITERI = 1
         NFEVI  = 1
         NJEVI  = 1
         INT2I  = 1
         IRANKI = 1
         LDTTI  = 1
         LIWKMN = 1
      END IF
*
      RETURN
      END
*SJACFD
      SUBROUTINE SJACFD
     +   (N,NP,M,BETA,
     +   X,LDX,DELTA,XPLUSD,LDXPD,FUN,
     +   SS,TT,LDTT,NETA,PV,STP,
     +   IFIXB,FJACB,LDFJB,ISODR,
     +   IFIXX,LDIFX,FJACX,LDFJX,NFEV,ISTOP)
C***BEGIN PROLOGUE  SJACFD
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE FINITE DIFFERENCE APPROXIMATIONS TO THE
C            JACOBIAN WRT THE ESTIMATED BETAS AND WRT THE DELTAS
C***END PROLOGUE  SJACFD
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ISTOP,LDFJB,LDFJX,LDIFX,LDTT,LDX,LDXPD,M,N,NETA,NFEV,NP
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),DELTA(N,M),FJACB(LDFJB,NP),
     +   FJACX(LDFJX,M),PV(N),SS(NP),STP(N),TT(LDTT,M),
     +   X(LDX,M),XPLUSD(LDXPD,M)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   BETAJ,ONE,SQREPS,TEN,TWO,TYPJ,ZERO
      INTEGER
     +   I,J,JFX
      LOGICAL
     +   DOIT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MAX,SIGN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TWO,TEN
     +   /0.0E0,1.0E0,2.0E0,10.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C     REAL BETAJ
C        THE J-TH FUNCTION PARAMETER.
C     REAL DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOIT
C        THE INDICATOR VARIABLE USED TO SPECIFY WHETHER THE DERIVATIVE
C        WRT A GIVEN BETA OR X NEEDS TO BE COMPUTED (DOIT=TRUE) OR NOT
C        (DOIT=FALSE).
C     REAL FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     REAL FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER ISTOP
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE
C        USER WISHES THE COMPUTATIONS STOPPED.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JFX
C        AN INDEXING VARIABLE.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF GOOD DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL PV(N)
C        THE PREDICTED VALUES OF THE MODEL FUNCTION AT THE CURRENT
C        POINT.
C     REAL SQREPS
C        THE SQUARE ROOT OF MACHINE PRECISION.
C     REAL SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL STP(N)
C        THE STEP USED TO COMPUTE FINITE DIFFERENCE DERIVATIVES.
C     REAL TEN
C        THE VALUE 10.0E0.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TWO
C        THE VALUE 2.0E0.
C     REAL TYPJ
C        THE TYPICAL SIZE OF THE J-TH UNKNOWN BETA OR DELTA.
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SJACFD
*
*
C  SET THE RELATIVE STEP SIZE FOR COMPUTING THE JACOBIANS
*
      SQREPS = TEN**(-NETA/TWO)
*
C  COMPUTE THE PREDICTED VALUES OF THE FUNCTION AT THE GIVEN POINT
*
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PV,ISTOP)
      NFEV = NFEV + 1
      IF (ISTOP.LT.0) THEN
         RETURN
      END IF
*
C  COMPUTE THE JACOBIAN WRT THE ESTIMATED BETAS
*
      JFX = 0
      DO 20 J=1,NP
         IF (IFIXB(1).GE.0) THEN
            IF (IFIXB(J).EQ.0) THEN
               DOIT = .FALSE.
            ELSE
               DOIT = .TRUE.
            END IF
         ELSE
            DOIT = .TRUE.
         END IF
         IF (DOIT) THEN
            JFX = JFX + 1
            BETAJ = BETA(J)
            TYPJ = ONE/SS(JFX)
            STP(J) = BETAJ + SQREPS*SIGN(ONE,BETAJ)*MAX(ABS(BETAJ),TYPJ)
            STP(J) = STP(J) - BETAJ
            BETA(J) = BETAJ + STP(J)
            CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,FJACB(1,JFX),ISTOP)
            NFEV = NFEV + 1
            IF (ISTOP.LT.0) THEN
               RETURN
            END IF
            DO 10 I=1,N
               FJACB(I,JFX) = (FJACB(I,JFX)-PV(I))/STP(J)
   10       CONTINUE
            BETA(J) = BETAJ
         END IF
   20 CONTINUE
*
C  COMPUTE THE JACOBIAN WRT THE X'S
*
      IF (ISODR) THEN
         DO 70 J=1,M
            IF (IFIXX(1,1).LT.0) THEN
               DOIT = .TRUE.
            ELSE IF (LDIFX.EQ.1) THEN
               IF (IFIXX(1,J).EQ.0) THEN
                  DOIT = .FALSE.
               ELSE
                  DOIT = .TRUE.
               END IF
            ELSE
               DO 30 I=1,N
                  IF (IFIXX(I,J).NE.0) THEN
                     DOIT = .TRUE.
                     GO TO 40
                  END IF
   30          CONTINUE
               DOIT = .FALSE.
   40          CONTINUE
            END IF
            IF (.NOT.DOIT) THEN
               CALL SZERO(N,1,FJACX(1,J),N)
            ELSE
               DO 50 I=1,N
                  IF (TT(1,1).GT.ZERO) THEN
                     IF (LDTT.EQ.1) THEN
                        TYPJ = ONE/TT(1,J)
                     ELSE
                        TYPJ = ONE/TT(I,J)
                     END IF
                  ELSE
                     TYPJ = ABS(ONE/TT(1,1))
                  END IF
                  STP(I) = XPLUSD(I,J) + SQREPS*SIGN(ONE,XPLUSD(I,J))*
     +                     MAX(ABS(XPLUSD(I,J)),TYPJ)
                  STP(I) = STP(I) - XPLUSD(I,J)
                  XPLUSD(I,J) = XPLUSD(I,J) + STP(I)
   50          CONTINUE
               CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,FJACX(1,J),ISTOP)
               NFEV = NFEV + 1
               IF (ISTOP.LT.0) THEN
                  RETURN
               END IF
               DO 60 I=1,N
                  FJACX(I,J) = (FJACX(I,J)-PV(I))/STP(I)
                  XPLUSD(I,J) = X(I,J) + DELTA(I,J)
   60          CONTINUE
            END IF
   70    CONTINUE
      END IF
*
      RETURN
      END
*SJCK
      SUBROUTINE SJCK
     +   (FUN,JAC,NFEV,NJEV,
     +   N,NP,M,BETA,XPLUSD,LDXPD,
     +   ETA,NETA,NTOL,SS,TT,LDTT,NROW,ISODR,EPSMAC,
     +   PVTEMP,FJACB,LDFJB,FJACX,LDFJX,
     +   MSGB,MSGX,ISTOPF,ISTOPJ)
C***BEGIN PROLOGUE  SJCK
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SJCKM
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  DRIVER ROUTINE FOR THE DERIVATIVE CHECKING PROCESS
C           (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKCNT)
C***END PROLOGUE  SJCK
*
C...SCALAR ARGUMENTS
      REAL
     +   EPSMAC,ETA
      INTEGER
     +   ISTOPF,ISTOPJ,LDFJB,LDFJX,LDTT,LDXPD,M,N,NETA,NFEV,
     +   NJEV,NP,NROW,NTOL
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),FJACB(LDFJB,NP),
     +   FJACX(LDFJX,M),PVTEMP(N),SS(NP),
     +   TT(LDTT,M),XPLUSD(LDXPD,M)
      INTEGER
     +   MSGB(NP+1),MSGX(M+1)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      REAL
     +   ONE,PV,TEN,TOL,TYPJ,ZERO
      INTEGER
     +   J
      LOGICAL
     +   ISWRTB
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SJCKM
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,INT,LOG10
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TEN
     +   /0.0E0,1.0E0,10.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL ETA
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     REAL FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     REAL FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE JACOBIAN GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF RELIABLE DIGITS IN THE MODEL RESULTS, EITHER
C        SET BY THE USER OR COMPUTED BY SETAF.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY
C        AT WHICH THE DERIVATIVE IS CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        EITHER SET BY THE USER OR COMPUTED FROM NETA.
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     REAL PVTEMP(N)
C        THE PREDICTED VALUE BASED ON THE CURRENT PARAMETER ESTIMATES
C     REAL SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TEN
C        THE VALUE 10.0E0.
C     REAL TOL
C        THE AGREEMENT TOLERANCE.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TYPJ
C        THE TYPICAL SIZE OF THE J-TH UNKNOWN BETA OR DELTA.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SJCK
*
*
C  SET TOLERANCE FOR CHECKING DERIVATIVES
*
      IF ((NTOL.LT.1) .OR. (NTOL.GT.(NETA+1)/2)) THEN
         NTOL = (NETA+3)/4
      END IF
*
      TOL = TEN**(-NTOL)
*
C  COMPUTE PREDICTED VALUE OF MODEL USING CURRENT PARAMETER
C  ESTIMATES, AND COMPUTE USER-SUPPLIED DERIVATIVE VALUES
*
      ISTOPF = 0
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,ISTOPF)
      NFEV = NFEV + 1
      IF (ISTOPF.NE.0) THEN
         RETURN
      END IF
      PV = PVTEMP(NROW)
*
      ISTOPJ = 0
      CALL JAC(N,NP,M,BETA,XPLUSD,LDXPD,FJACB,LDFJB,
     +         ISODR,FJACX,LDFJX,ISTOPJ)
      NJEV = NJEV + 1
      IF (ISTOPJ.NE.0) THEN
         RETURN
      END IF
*
C  CHECK DERIVATIVES WRT BETA
*
      ISWRTB = .TRUE.
      MSGB(1) = 0
*
      DO 10 J=1,NP
*
         IF (SS(1).GT.ZERO) THEN
            TYPJ = ONE/SS(J)
         ELSE
            TYPJ = ONE/ABS(SS(1))
         END IF
*
C  CHECK DERIVATIVE WRT THE J-TH PARAMETER AT THE NROW-TH ROW
*
         CALL SJCKM(FUN,NFEV,
     +              N,NP,M,XPLUSD,LDXPD,BETA,TYPJ,
     +              ETA,TOL,EPSMAC,
     +              J,NROW,PV,FJACB(NROW,J),PVTEMP,
     +              ISWRTB,MSGB,NP+1,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
*
   10 CONTINUE
*
C  CHECK DERIVATIVES WRT X
*
      MSGX(1) = 0
*
      IF (ISODR) THEN
         ISWRTB = .FALSE.
         DO 20 J=1,M
*
            IF (TT(1,1).GT.ZERO) THEN
               IF (LDTT.EQ.1) THEN
                  TYPJ = ONE/TT(1,J)
               ELSE
                  TYPJ = ONE/TT(NROW,J)
               END IF
            ELSE
               TYPJ = ABS(ONE/TT(1,1))
            END IF
*
C  CHECK DERIVATIVE WRT THE J-TH COLUMN OF X AT ROW NROW
*
            CALL SJCKM(FUN,NFEV,
     +                 N,NP,M,XPLUSD,LDXPD,BETA,TYPJ,
     +                 ETA,TOL,EPSMAC,
     +                 J,NROW,PV,FJACX(NROW,J),PVTEMP,
     +                 ISWRTB,MSGX,M+1,ISTOPF)
            IF (ISTOPF.NE.0) THEN
               RETURN
            END IF
*
   20    CONTINUE
      END IF
*
C  PRINT RESULTS IF THEY ARE DESIRED
*
      RETURN
*
      END
*SJCKC
      SUBROUTINE SJCKC
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,EPSMAC,
     +   J,NROW,PV,D,FD,PARMX,PVPSTP,STP,
     +   PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  SJCKC
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SJCKF,SPVB,SPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK WHETHER HIGH CURVATURE COULD BE THE CAUSE OF THE
C            DISAGREEMENT BETWEEN THE NUMERICAL AND ANALYTIC DERVIATIVES
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKCRV)
C***END PROLOGUE  SJCKC
*
C...SCALAR ARGUMENTS
      REAL
     +   D,EPSMAC,ETA,FD,PARMX,PV,PVPSTP,STP,TOL
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   CURVE,FIVE,ONE,PVMCRV,PVPCRV,STPCRV,THIRD,THREE,TWO
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SPVB,SPVD
      EXTERNAL
     +   SPVB,SPVD
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SJCKF
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,SIGN
*
C...DATA STATEMENTS
      DATA
     +   ONE,TWO,THREE,FIVE
     +   /1.0E0,2.0E0,3.0E0,5.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL CURVE
C        A MEASURE OF THE CURVATURE IN THE MODEL.
C     REAL D
C        THE SCALAR IN WHICH ROW   NROW   OF THE DERIVATIVE
C        MATRIX WITH RESPECT TO THE JTH UNKNOWN PARAMETER
C        IS STORED.
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL ETA
C        THE RELATIVE NOISE IN THE MODEL.
C     REAL FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER.
C     REAL FIVE
C         THE VALUE 5.0E0.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL ONE
C         THE VALUE 1.0E0.
C     REAL PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE.
C     REAL PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     REAL PVMCRV
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J)-STPCRV.
C     REAL PVPCRV
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J)+STPCRV.
C     REAL PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     REAL PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     REAL STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     REAL STPCRV
C        THE STEP SIZE SELECTED TO CHECK FOR CURVATURE IN THE MODEL.
C     REAL THIRD
C        THE VALUE 1.0E0/3.0E0.
C     REAL THREE
C         THE VALUE 3.0E0.
C     REAL TOL
C        THE AGREEMENT TOLERANCE.
C     REAL TWO
C         THE VALUE 2.0E0.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  SJCKC
*
*
      THIRD = ONE/THREE
*
      IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
         STPCRV = (ETA**THIRD*PARMX*SIGN(ONE,BETA(J))+BETA(J)) - BETA(J)
         PVPCRV = SPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                  NROW,J,STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
         PVMCRV = SPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                  NROW,J,-STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
      ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
         STPCRV = (ETA**THIRD*PARMX*SIGN(ONE,XPLUSD(NROW,J))+
     +             XPLUSD(NROW,J)) - XPLUSD(NROW,J)
         PVPCRV = SPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
         PVMCRV = SPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,-STPCRV,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
      END IF
*
C  ESTIMATE CURVATURE BY SECOND DERIVATIVE OF MODEL
*
      CURVE = ((PVPCRV-PV)+(PVMCRV-PV)) / (STPCRV*STPCRV)
      CURVE = CURVE + (ETA ** THIRD) * (ABS(PVPCRV) +
     +        ABS(PVMCRV) + TWO * ABS(PV)) / (PARMX * PARMX)
*
C  COMPARE NUMERICAL AND ANALYTICAL DERIVATIVES USING A FUDGE
C  FACTOR OF TEN.
*
      IF (ABS(CURVE*STP)*FIVE.LT.ABS(FD-D)) THEN
*
C  CURVATURE CANNOT ACCOUNT FOR DISCREPANCY.
*
C  CHECK IF FINITE PRECISION ARITHMETIC COULD BE THE CULPRIT.
*
         CALL SJCKF(FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,
     +              J,NROW,PV,D,FD,PARMX,PVPSTP,STP,CURVE,
     +              PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
*
      ELSE
*
C  HIGH CURVATURE COULD BE THE PROBLEM.  TRY A SMALLER STEP SIZE.
*
C  COMPUTE DERIVATIVE WITH SMALLER STEP SIZE
C  IF SMALLER STEP SIZE IS TOO SMALL SET MSG(J+1)=1 ELSE COMPUTE
C  PREDICTED VALUE WITH NEW STEP.
*
         IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
            STP = (TWO*TOL*ABS(D)*SIGN(ONE,BETA(J)) /
     +             ABS(CURVE)+BETA(J)) - BETA(J)
            IF (ABS(STP).LE.EPSMAC*ABS(BETA(J))) THEN
               IF (MSG(1).EQ.0) MSG(1) = 2
               MSG(J+1) = 6
               RETURN
            ELSE
               PVPSTP = SPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                       NROW,J,STP,ISTOPF)
               IF (ISTOPF.NE.0) THEN
                  RETURN
               END IF
            END IF
         ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
            STP = (TWO*TOL*ABS(D)*SIGN(ONE,XPLUSD(NROW,J)) /
     +             ABS(CURVE)+XPLUSD(NROW,J)) - XPLUSD(NROW,J)
            IF (ABS(STP).LE.EPSMAC*ABS(XPLUSD(NROW,J))) THEN
               IF (MSG(1).EQ.0) MSG(1) = 2
               MSG(J+1) = 6
               RETURN
            ELSE
               PVPSTP = SPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                       NROW,J,STP,ISTOPF)
               IF (ISTOPF.NE.0) THEN
                  RETURN
               END IF
            END IF
         END IF
*
C  COMPUTE THE NEW NUMERICAL DERIVATIVE
*
         FD = (PVPSTP-PV)/STP
*
C  CHECK WHETHER THE NEW NUMERICAL DERIVATIVE IS OK
*
         IF (ABS(FD-D).GT.TWO*TOL*ABS(D)) THEN
*
C  NUMERICAL DERIVATIVE COMPUTED USING NEW STEP SIZE DOES
C  NOT AGREE WITH ANALYTIC DERIVATIVE.
*
C  CHECK IF THE PROBLEM COULD BE THE FORWARD DIFFERENCE QUOTIENT
C  DERIVATIVE.
*
C  (FUDGE FACTOR IS 2)
*
            IF (ABS(STP*(FD-D)).GE.TWO*ETA*ABS(PV+PVPSTP)) THEN
*
C  FINITE PRECISION COULD NOT BE THE CULPRIT
*
               MSG(1) = 1
               MSG(J+1) = 1
            ELSE
*
C  FINITE PRECISION MAY BE THE CULPRIT
*
               IF (MSG(1).EQ.0) MSG(1) = 2
               MSG(J+1) = 6
            END IF
         END IF
      END IF
*
      RETURN
      END
*SJCKF
      SUBROUTINE SJCKF
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,
     +   J,NROW,PV,D,FD,PARMX,PVPSTP,STP,CURVE,
     +   PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  SJCKF
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SPVB,SPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK WHETHER FINITE PRECISION ARITHMETIC COULD BE THE
C            CAUSE OF THE DISAGREEMENT BETWEEN THE DERIVATIVES.
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKFPA)
C***END PROLOGUE  SJCKF
*
C...SCALAR ARGUMENTS
      REAL
     +   CURVE,D,ETA,FD,PARMX,PV,PVPSTP,STP,TOL
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   ONE,TEN,TWO
      LOGICAL
     +   LARGE
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SPVB,SPVD
      EXTERNAL
     +   SPVB,SPVD
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,SIGN
*
C...DATA STATEMENTS
      DATA
     +   ONE,TWO,TEN
     +   /1.0E0,2.0E0,10.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL CURVE
C        A MEASURE OF THE CURVATURE IN THE MODEL.
C     REAL D
C        THE SCALAR IN WHICH ROW   NROW   OF THE DERIVATIVE
C        MATRIX WITH RESPECT TO THE JTH UNKNOWN PARAMETER
C        IS STORED.
C     REAL ETA
C        THE RELATIVE NOISE IN THE MODEL
C     REAL FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     LOGICAL LARGE
C        AN INDICATOR VALUE INDICATING WHETHER THE RECOMMENDED
C        INCREASE IN THE STEP SIZE WOULD BE GREATER THAN PARMX.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE AND THE
C        TYPICAL VALUE OF THAT PARAMETER
C     REAL PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     REAL PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     REAL PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     REAL STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     REAL TEN
C        THE VALUE 10.0E0.
C     REAL TOL
C        THE AGREEMENT TOLERANCE.
C     REAL TWO
C        THE VALUE 2.0E0.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  SJCKF
*
*
C  CHECK WHETHER FINITE PRECISION COULD BE THE PROBLEM
*
      IF (ABS(STP*(FD-D)).GE.TEN*ETA*(ABS(PV)+ABS(PVPSTP))) THEN
*
C  DISCREPANCY BETWEEN NUMERICAL AND ANALYTICAL DERIVATIVES CANNOT
C  BE ACCOUNTED FOR BY FINITE PRECISION ARITHMETIC
*
         MSG(1) = 1
         MSG(J+1) = 1
      ELSE
*
C  FINITE PRECISION ARITHMETIC COULD BE THE PROBLEM.
C  TRY A LARGER STEP SIZE
*
*
         IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
            STP = (ETA*(ABS(PV)+ABS(PVPSTP))*SIGN(ONE,BETA(J))/
     +            (TOL*ABS(D))+BETA(J)) - BETA(J)
            IF (ABS(STP).GT.PARMX) THEN
               STP = PARMX*SIGN(ONE,BETA(J))
               LARGE = .TRUE.
            ELSE
               LARGE = .FALSE.
            END IF
            PVPSTP = SPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                    NROW,J,STP,ISTOPF)
         ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
            STP = (ETA*(ABS(PV)+ABS(PVPSTP))*SIGN(ONE,XPLUSD(NROW,J))/
     +            (TOL*ABS(D))+XPLUSD(NROW,J)) - XPLUSD(NROW,J)
            IF (ABS(STP).GT.PARMX) THEN
               STP = PARMX*SIGN(ONE,XPLUSD(NROW,J))
               LARGE = .TRUE.
            ELSE
               LARGE = .FALSE.
            END IF
            PVPSTP = SPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                    NROW,J,STP,ISTOPF)
         END IF
         IF (ISTOPF.NE.0) THEN
            RETURN
         END IF
*
         FD = (PVPSTP-PV)/STP
*
C  CHECK FOR AGREEMENT
*
         IF ((ABS(FD-D)).GT.TWO*TOL*ABS(D)) THEN
*
C  FORWARD DIFFERENCE QUOTIENT AND ANALYTIC DERIVATIVES STILL DISAGREE.
C  CHECK IF CURVATURE IS THE PROBLEM
*
            IF (ABS(CURVE*STP).GE.ABS(FD-D) .OR. LARGE) THEN
*
C  CURVATURE MAY BE THE CULPRIT
*
               IF (MSG(1).EQ.0) MSG(1) = 2
               IF (LARGE) THEN
                  MSG(J+1) = 5
               ELSE
                  MSG(J+1) = 6
               END IF
            ELSE
*
C  CURVATURE COULDNT BE THE CULPRIT
*
               MSG(1) = 1
               MSG(J+1) = 1
            END IF
         END IF
      END IF
*
      RETURN
      END
*SJCKM
      SUBROUTINE SJCKM
     +   (FUN,NFEV,
     +   N,NP,M,XPLUSD,LDXPD,BETA,TYPJ,
     +   ETA,TOL,EPSMAC,
     +   J,NROW,PV,D,PVTEMP,
     +   ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  SJCKM
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SJCKC,SJCKZ,SPVB,SPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK USER-SUPPLIED ANALYTIC DERIVATIVES AGAINST NUMERICAL
C            DERIVATIVES
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKMN.)
C***END PROLOGUE  SJCKM
*
C...SCALAR ARGUMENTS
      REAL
     +   D,EPSMAC,ETA,PV,TOL,TYPJ
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   FD,ONE,PARMX,PVPSTP,STP,ZERO
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SPVB,SPVD
      EXTERNAL
     +   SPVB,SPVD
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SJCKC,SJCKZ
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MAX,SIGN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0E0,1.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL D
C        THE SCALAR IN WHICH ROW   NROW   OF THE DERIVATIVE
C        MATRIX WITH RESPECT TO THE JTH UNKNOWN PARAMETER
C        IS STORED.
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL ETA
C        THE RELATIVE NOISE IN THE MODEL
C     REAL FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR DELTA(ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL ONE
C         THE VALUE 1.0E0.
C     REAL PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE AND THE
C        TYPICAL VALUE OF THAT PARAMETER
C     REAL PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     REAL PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     REAL PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     REAL STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     REAL TOL
C        THE AGREEMENT TOLERANCE.
C     REAL TYPJ
C        THE TYPICAL SIZE OF THE J-TH UNKNOWN BETA OR DELTA.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C         THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SJCKM
*
*
C  CALCULATE THE JTH PARTIAL DERIVATIVE USING FORWARD DIFFERENCE
C  QUOTIENTS AND DECIDE IF IT AGREES WITH USER SUPPLIED VALUES
*
      MSG(J+1) = 0
*
      IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
         PARMX = MAX(ABS(BETA(J)),ABS(TYPJ))
         STP = (SQRT(ETA)*PARMX*SIGN(ONE,BETA(J))+BETA(J)) - BETA(J)
         PVPSTP = SPVB(FUN,NFEV,
     +                 N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,STP,ISTOPF)
      ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
         PARMX = MAX(ABS(XPLUSD(NROW,J)),ABS(TYPJ))
         STP = (SQRT(ETA)*PARMX*SIGN(ONE,XPLUSD(NROW,J))+XPLUSD(NROW,J))
     +         - XPLUSD(NROW,J)
         PVPSTP = SPVD(FUN,NFEV,
     +                 N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,STP,ISTOPF)
      END IF
      IF (ISTOPF.NE.0) THEN
         RETURN
      END IF
*
      FD = (PVPSTP-PV)/STP
*
C  CHECK FOR DISAGREEMENT
*
      IF (ABS(FD-D).LE.TOL*ABS(D)) THEN
*
C  NUMERICAL AND ANALYTIC DERIVATIVES AGREE
*
C  CHECK IF ANALYTIC DERIVATIVE IS IDENTICALLY ZERO, INDICATING
C  THE POSSIBILITY THAT THE DERIVATIVE SHOULD BE RECHECKED AT
C  ANOTHER POINT.
*
         IF (D.EQ.ZERO) THEN
*
C  JTH ANALYTIC AND NUMERICAL DERIVATIVES BOTH ARE ZERO.
C  SET MSG FLAG ACCORDINGLY.
*
            IF (MSG(1).EQ.0) MSG(1) = 2
            MSG(J+1) = 2
         END IF
*
      ELSE
*
C  NUMERICAL AND ANALYTIC DERIVATIVES DISAGREE
*
C  CHECK WHY
*
         IF (D.EQ.ZERO) THEN
            CALL SJCKZ(FUN,NFEV,
     +                 N,NP,M,XPLUSD,LDXPD,BETA,EPSMAC,
     +                 J,NROW,PV,FD,PARMX,PVPSTP,STP,
     +                 PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
         ELSE
            CALL SJCKC(FUN,NFEV,
     +                 N,NP,M,XPLUSD,LDXPD,BETA,ETA,TOL,EPSMAC,
     +                 J,NROW,PV,D,FD,PARMX,PVPSTP,STP,
     +                 PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
         END IF
      END IF
*
      RETURN
      END
*SJCKZ
      SUBROUTINE SJCKZ
     +   (FUN,NFEV,N,NP,M,XPLUSD,LDXPD,BETA,EPSMAC,
     +   J,NROW,PV,FD,PARMX,PVPSTP,STP,
     +   PVTEMP,ISWRTB,MSG,LMSG,ISTOPF)
C***BEGIN PROLOGUE  SJCKZ
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SPVB,SPVD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  RECHECK THE DERIVATIVES IN THE CASE WHERE THE FINITE
C            DIFFERENCE DERIVATIVE DISAGREES WITH THE ANALYTIC
C            DERIVATIVE AND THE ANALYTIC DERIVATIVE IS ZERO.
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKZRO)
C***END PROLOGUE  SJCKZ
*
C...SCALAR ARGUMENTS
      REAL
     +   EPSMAC,FD,PARMX,PV,PVPSTP,STP
      INTEGER
     +   ISTOPF,J,LDXPD,LMSG,M,N,NFEV,NP,NROW
      LOGICAL
     +   ISWRTB
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
      INTEGER
     +   MSG(LMSG)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   CD,ONE,PVMSTP,THREE,TWO,ZERO
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SPVB,SPVD
      EXTERNAL
     +   SPVB,SPVD
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TWO,THREE
     +   /0.0E0,1.0E0,2.0E0,3.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL CD
C        THE CENTRAL DIFFERENCE QUOTIENT DERIVATIVE WITH
C        RESPECT TO THE JTH PARAMETER.
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL FD
C        THE FORWARD DIFFERENCE QUOTIENT DERIVATIVE WITH RESPECT TO THE
C        JTH PARAMETER.
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     LOGICAL ISWRTB
C        THE CONTROL VALUE DETERMINING WHETHER THE DERIVATIVES WRT
C        BETA (ISWRTB=TRUE) OR X (ISWRTB=FALSE) ARE BEING CHECKED.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LMSG
C        THE LENGTH OF THE VECTOR MSG.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSG(LMSG)
C        THE ERROR CHECKING RESULTS.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL PARMX
C        THE MAXIMUM OF THE CURRENT PARAMETER ESTIMATE AND THE TYPICAL
C        VALUE OF THAT PARAMETER.
C     REAL PV
C        THE SCALAR IN WHICH THE PREDICTED VALUE FROM THE MODEL FOR
C        ROW   NROW   IS STORED.
C     REAL PVMSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) - STP.
C     REAL PVPSTP
C        THE PREDICTED VALUE FOR ROW    NROW   OF THE MODEL
C        BASED ON THE CURRENT PARAMETER ESTIMATES
C        FOR ALL BUT THE JTH PARAMETER VALUE, WHICH IS BETA(J) + STP.
C     REAL PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUES FROM THE MODEL.
C     REAL STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE
C     REAL THREE
C        THE VALUE 3.0E0.
C     REAL TWO
C        THE VALUE 2.0E0.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SJCKZ
*
*
C  RECALCULATE NUMERICAL DERIVATIVE USING CENTRAL DIFFERENCE AND STEP
C  SIZE OF 2*STP
*
      IF (ISWRTB) THEN
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT BETA
*
         PVMSTP = SPVB(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,-STP,ISTOPF)
      ELSE
*
C  PERFORM COMPUTATIONS FOR DERIVATIVES WRT DELTA
*
         PVMSTP = SPVD(FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,
     +                 NROW,J,-STP,ISTOPF)
      END IF
      IF (ISTOPF.NE.0) THEN
         RETURN
      END IF
*
      CD = (PVPSTP-PVMSTP)/(TWO*STP)
*
C  CHECK FOR DISAGREEMENT
*
      IF (CD.EQ.ZERO) THEN
*
C  NUMERICAL AND ANALYTIC DERIVATIVES NOW AGREE, BUT BOTH EQUAL ZERO,
C  INDICATING THAT DERIVATIVES SHOULD BE RECHECKED AT ANOTHER POINT.
*
         IF (MSG(1).EQ.0) MSG(1) = 2
         MSG(J+1) = 2
      ELSE
*
C  NUMERICAL AND ANALYTIC DERIVATIVE STILL DO NOT AGREE.
C  CHECK IF NUMERICAL DERIVATIVE IS CLOSE TO ZERO.
*
         IF (MIN(ABS(CD),ABS(FD))*PARMX.LE.
     +          ABS(PV*EPSMAC**(ONE/THREE))) THEN
*
C  NUMERICAL DERIVATIVE IS CLOSE TO ZERO
*
            IF (MSG(1).EQ.0) MSG(1) = 2
            MSG(J+1) = 3
         ELSE
*
C  NUMERICAL DERIVATIVE NOT CLOSE TO ZERO
*
            IF (MSG(1).EQ.0) MSG(1) = 2
            MSG(J+1) = 4
         END IF
      END IF
*
      RETURN
      END
*SODCHK
      SUBROUTINE SODCHK
     +   (N,NP,M,
     +   IFIXB,
     +   LDX,LDIFX,LDSCLD,LDWD,
     +   LWORK,LWKMN,LIWORK,LIWKMN,
     +   SCLD,SCLB,W,WD,
     +   INFO)
C***BEGIN PROLOGUE  SODCHK
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CHECK INPUT PARAMETERS, INDICATING ERRORS FOUND USING
C            NONZERO VALUES OF ARGUMENT INFO AS DESCRIBED IN THE
C            PROLOGUES FOR SODR AND SODRC.
C***END PROLOGUE  SODCHK
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,LDIFX,LDSCLD,LDWD,LDX,LIWKMN,LIWORK,LWKMN,LWORK,M,N,
     +   NP
*
C...ARRAY ARGUMENTS
      REAL
     +   SCLB(NP),SCLD(LDSCLD,M),W(N),WD(LDWD,M)
      INTEGER
     +   IFIXB(NP)
*
C...LOCAL SCALARS
      REAL
     +   ZERO
      INTEGER
     +   I,J,K,LAST,NNZW,NPP
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   LOG10
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER LAST
C        THE LAST ROW OF THE ARRAY TO BE ACCESSED.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODCHK
*
*
C  FIND ACTUAL NUMBER OF PARAMETERS BEING ESTIMATED
*
      IF (NP.LE.0 .OR. IFIXB(1).LT.0) THEN
         NPP = NP
      ELSE
         NPP = 0
         DO 10 K=1,NP
            IF (IFIXB(K).NE.0) THEN
               NPP = NPP + 1
            END IF
   10    CONTINUE
      END IF
*
C  CHECK PROBLEM SPECIFICATION PARAMETERS
*
      IF (N.LE.0 .OR. M.LE.0 .OR. NPP.LE.0 .OR. NPP.GT.N) THEN
         INFO = 10000
         IF (N.LE.0) THEN
            INFO = INFO + 1000
         END IF
         IF (M.LE.0) THEN
            INFO = INFO + 100
         END IF
         IF (NPP.LE.0 .OR. NPP.GT.N) THEN
            INFO = INFO + 10
         END IF
         RETURN
      END IF
*
C  CHECK DIMENSION SPECIFICATION PARAMETERS
*
      IF (LDX.LT.N .OR.
     +   (LDIFX.NE.1 .AND. LDIFX.LT.N) .OR.
     +   (LDSCLD.NE.1 .AND. LDSCLD.LT.N) .OR.
     +   (LDWD.NE.1 .AND. LDWD.LT.N) .OR.
     +   LWORK.LT.LWKMN .OR. LIWORK.LT.LIWKMN) THEN
         INFO = 20000
         IF (LDX.LT.N) THEN
            INFO = INFO + 1000
         END IF
         IF (LDIFX.NE.1 .AND. LDIFX.LT.N) THEN
            INFO = INFO + 100
         END IF
         IF (LDSCLD.NE.1 .AND. LDSCLD.LT.N) THEN
            INFO = INFO + 200
         END IF
         IF (LDWD.NE.1 .AND. LDWD.LT.N) THEN
            INFO = INFO + 400
         END IF
         IF (LWORK.LT.LWKMN) THEN
            INFO = INFO + 10
         END IF
         IF (LIWORK.LT.LIWKMN) THEN
            INFO = INFO + 1
         END IF
         RETURN
      END IF
*
C  CHECK DELTA SCALING
*
      IF (SCLD(1,1).GT.0) THEN
         DO 30 J=1,M
            IF (LDSCLD.GE.N) THEN
               LAST = N
            ELSE
               LAST = 1
            END IF
            DO 20 I=1,LAST
               IF (SCLD(I,J).LE.0) THEN
                  INFO = 31000
                  GO TO 40
               END IF
   20       CONTINUE
   30    CONTINUE
      END IF
*
C  CHECK BETA SCALING
*
   40 IF (SCLB(1).GT.0) THEN
         DO 50 K=1,NP
            IF (SCLB(K).LE.0) THEN
               IF (INFO.EQ.0) THEN
                  INFO = 30100
               ELSE
                  INFO = INFO + 100
               END IF
               GO TO 60
            END IF
   50    CONTINUE
      END IF
*
C  CHECK OBSERVATIONAL ERROR WEIGHTS IF INDIVIDUALLY SPECIFIED
*
   60 IF (W(1).GE.ZERO) THEN
         NNZW = 0
         DO 70 I=1,N
            IF (W(I).LT.ZERO) THEN
               IF (INFO.EQ.0) THEN
                  INFO = 30010
               ELSE
                  INFO = INFO + 10
               END IF
               GO TO 80
            ELSE IF (W(I).GT.ZERO) THEN
               NNZW = NNZW + 1
            END IF
   70    CONTINUE
         IF (NNZW.LT.NPP) THEN
            IF (INFO.EQ.0) THEN
               INFO = 30020
            ELSE
               INFO = INFO + 20
            END IF
         END IF
      END IF
*
C  CHECK DELTA WEIGHTS IF INDIVIDUALLY SPECIFIED
*
   80 IF (WD(1,1).GE.ZERO) THEN
         DO 100 J=1,M
            IF (LDWD.GE.N) THEN
               LAST = N
            ELSE
               LAST = 1
            END IF
            DO 90 I=1,LAST
               IF (WD(I,J).LE.ZERO) THEN
                  IF (INFO.EQ.0) THEN
                     INFO = 30001
                  ELSE
                     INFO = INFO + 1
                  END IF
                  GO TO 110
               END IF
   90       CONTINUE
  100    CONTINUE
      END IF
*
  110 RETURN
*
      END
*SODDRV
      SUBROUTINE SODDRV
     +   (SHORT,
     +   FUN,JAC,
     +   N,M,NP,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   Y,
     +   BETA,IFIXB,SCLB,
     +   WD,LDWD,W,
     +   JOB,NDIGIT,TAUFAC,
     +   SSTOL,PARTOL,MAXIT,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
C***BEGIN PROLOGUE  SODDRV
C***REFER TO SODR,SODRC
C***ROUTINES CALLED  SCOPY,SDIAGS,SDOT,SETAF,SEVFUN,SFLAGS,
C                    SINIWK,SIWINF,SJCK,SNRM2,SODCHK,SODMN,
C                    SODPER,SPACK,SSETN,SWDS,SWINF
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PERFORM ERROR CHECKING AND INITIALIZATION, AND BEGIN
C            PROCEDURE FOR PERFORMING ORTHOGONAL DISTANCE REGRESSION
C            (ODR) ORDINARY LINEAR OR NONLINEAR LEAST SQUARES (OLS)
C***END PROLOGUE  SODDRV
*
C...SCALAR ARGUMENTS
      REAL
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   INFO,IPRINT,JOB,LDIFX,LDSCLD,LDWD,LDX,LIWORK,LUNERR,
     +   LUNRPT,LWORK,M,MAXIT,N,NDIGIT,NP
      LOGICAL
     +   SHORT
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),SCLB(NP),SCLD(LDSCLD,M),
     +   W(N),WD(LDWD,M),WORK(LWORK),X(LDX,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),IWORK(LIWORK)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      REAL
     +   EPSMAC,ETA,TEN,ZERO
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSMAI,ETAI,FI,FJACBI,FJACXI,FNI,FSI,I,IDFI,INT2I,IPRINI,
     +   IRANKI,ISTOPF,ISTOPJ,JOBI,JPVTI,LDTT,LDTTI,LIWKMN,LUNERI,
     +   LUNRPI,LWKMN,MAXITI,MSGB,MSGX,NETA,NETAI,NFEV,NFEVI,NITERI,
     +   NJEV,NJEVI,NNZWI,NPPI,NROW,NROWI,NTOL,NTOLI,OLMAVI,OMEGAI,
     +   PARTLI,PNORMI,PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,SI,SSFI,SSI,
     +   SSSI,SSTOLI,TAUFCI,TAUI,TFJACI,TI,TTI,UI,WRK1I,WRK2I,WSSI,
     +   WSSDEI,WSSEPI,XPLUSI,YTI
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SDOT,SNRM2
      EXTERNAL
     +   SDOT,SNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SCOPY,SDIAGS,SETAF,SEVFUN,SFLAGS,SINIWK,SIWINF,SJCK,
     +   SODCHK,SODMN,SODPER,SPACK,SSETN,SWDS,SWINF
*
C...DATA STATEMENTS
      DATA
     +   ZERO,TEN
     +   /0.0E0,10.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     REAL ETA
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER FI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER I
C        AN INDEX VARIABLE.
C     INTEGER IDFI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER INT2I
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF INTERNAL DOUBLING STEPS.
C     INTEGER IPRINI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PRINT CONTROL VARIABLE.
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IRANKI
C        THE LOCATION IN ARRAY IWORK OF
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE JACOBIAN GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOBI
C        THE LOCATION IN ARRAY IWORK OF
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C     INTEGER JPVTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDTTI
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXITI
C        THE LOCATION IN ARRAY IWORK OF
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C     INTEGER MSGB
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX
C        THE STARTING LOCATION IN ARRAY IWORK OF
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NETAI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NFEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITERI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NJEVI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPPI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     INTEGER NROW
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NROWI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY SJCK.
C     INTEGER NTOLI
C        THE LOCATION IN ARRAY IWORK OF
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        NUMERICAL DERIVATIVES AND THE USER SUPPLIED DERIVATIVES,
C        TO BE SET BY SJCK.
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE, I.E. STANDARD DEVIATION SQUARED.
C     REAL SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     REAL TEN
C        THE VALUE 10.0E0.
C     INTEGER TFJACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WORK(LWORK)
C        THE REAL WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     REAL Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER YTI
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODDRV
*
*
C  SET STARTING LOCATIONS WITHIN INTEGER WORKSPACE
C  (INVALID VALUES OF M AND/OR NP ARE HANDLED REASONABLY BY SIWINF)
*
      CALL SIWINF(M,NP,
     +            MSGB,MSGX,JPVTI,
     +            NNZWI,NPPI,IDFI,
     +            JOBI,IPRINI,LUNERI,LUNRPI,
     +            NROWI,NTOLI,NETAI,
     +            MAXITI,NITERI,NFEVI,NJEVI,INT2I,IRANKI,LDTTI,
     +            LIWKMN)
*
C  SET STARTING LOCATIONS WITHIN REAL WORK SPACE
C  (INVALID VALUES OF N, M AND/OR NP ARE HANDLED REASONABLY BY SWINF)
*
      CALL SWINF(N,M,NP,
     +           DELTAI,FI,
     +           WSSI,WSSDEI,WSSEPI,RVARI,
     +           PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +           FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +           DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +           ALPHAI,TFJACI,OMEGAI,YTI,UI,QRAUXI,WRK1I,WRK2I,RCONDI,
     +           ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +           LWKMN)
*
C  INITIALIZE NECESSARY VARIABLES
*
      CALL SFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
      INFO = 0
*
      IF (RESTRT) THEN
*
C  RESET MAXIMUM NUMBER OF ITERATIONS
*
         IWORK(JOBI) = (JOB/10000)*10000 + MOD(IWORK(JOBI),10000)
         IWORK(MAXITI) = IWORK(MAXITI) + 10
         WORK(OLMAVI) = WORK(OLMAVI)*IWORK(NITERI)
         CALL SCOPY(N,WORK(SSSI),1,WORK(FI),1)
*
      ELSE
*
C  PERFORM ERROR CHECKING
*
         CALL SODCHK(N,NP,M,
     +               IFIXB,
     +               LDX,LDIFX,LDSCLD,LDWD,
     +               LWORK,LWKMN,LIWORK,LIWKMN,
     +               SCLD,SCLB,W,WD,
     +               INFO)
         IF (INFO.NE.0) THEN
            GO TO 20
         END IF
*
C  INITIALIZE WORK VECTORS AS NECESSARY
*
         CALL SINIWK(N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +               X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +               BETA,SCLB,
     +               SSTOL,PARTOL,MAXIT,TAUFAC,
     +               JOB,IPRINT,LUNERR,LUNRPT,
     +               EPSMAI,SSTOLI,PARTLI,MAXITI,TAUFCI,
     +               JOBI,IPRINI,LUNERI,LUNRPI,
     +               SSFI,TTI,LDTTI,DELTAI)
*
         IWORK(INT2I)  = 0
         IWORK(IRANKI) = 0
         IWORK(NFEVI)  = 0
         IWORK(NITERI) = 0
         IWORK(NJEVI)  = 0
         IWORK(IDFI)   = 0
*
         WORK(ACTRSI)  = ZERO
         WORK(ALPHAI)  = ZERO
         WORK(OLMAVI)  = ZERO
         WORK(PNORMI)  = ZERO
         WORK(PRERSI)  = ZERO
         WORK(RCONDI)  = ZERO
         WORK(WSSI)    = ZERO
         WORK(WSSEPI)  = ZERO
         WORK(WSSDEI)  = ZERO
         WORK(RVARI)   = ZERO
         WORK(RNORSI)  = ZERO
*
         WORK(TAUI)    = -WORK(TAUFCI)
*
C  SET UP FOR PARAMETER ESTIMATION -
C  PULL BETA'S TO BE ESTIMATED AND CORRESPONDING SCALE VALUES
C  AND STORE IN WORK(BETACI) AND WORK(SSI), RESPECTIVELY
*
         CALL SPACK(NP,IWORK(NPPI),WORK(BETACI),BETA,IFIXB)
         IF (WORK(SSFI).GT.ZERO) THEN
            CALL SPACK(NP,IWORK(NPPI),WORK(SSI),WORK(SSFI),IFIXB)
         ELSE
            WORK(SSI) = WORK(SSFI)
         END IF
*
C  EVALUATE THE WEIGHTED EPSILONS AT THE STARTING POINT
*
         CALL SEVFUN(N,NP,M,WORK(BETACI),BETA,IFIXB,FUN,
     +               X,LDX,Y,WORK(DELTAI),N,WORK(XPLUSI),N,
     +               W,WORK(FI),IWORK(NFEVI),ISTOPF)
         IF (ISTOPF.NE.0) THEN
            INFO = 52000
            GO TO 20
         END IF
*
C  FIND NUMBER OF NONZERO WEIGHTS
*
         IF (W(1).LT.ZERO) THEN
            IWORK(NNZWI) = N
         ELSE
            IWORK(NNZWI) = 0
            DO 10 I=1,N
               IF (W(I).GT.ZERO) THEN
                  IWORK(NNZWI) = IWORK(NNZWI) + 1
               END IF
   10       CONTINUE
         END IF
*
C  COMPUTE NORM OF THE INITIAL ESTIMATES
*
         CALL SDIAGS(IWORK(NPPI),1,WORK(SSI),IWORK(NPPI),
     +               WORK(BETACI),IWORK(NPPI),WORK(SSSI),IWORK(NPPI))
         CALL SDIAGS(N,M,WORK(TTI),IWORK(LDTTI),WORK(DELTAI),N,
     +               WORK(SSSI+IWORK(NPPI)),N)
         WORK(PNORMI) = SNRM2(IWORK(NPPI)+N*M,WORK(SSSI),1)
*
C  COMPUTE SUM OF SQUARES OF THE WEIGHTED EPSILONS AND WEIGHTED DELTAS
*
         CALL SCOPY(N,WORK(FI),1,WORK(SSSI),1)
         WORK(WSSEPI) = SDOT(N,WORK(SSSI),1,WORK(SSSI),1)
         CALL SWDS(N,M,W,WD,LDWD,WORK(DELTAI),N,WORK(SSSI+N),N)
         WORK(WSSDEI) = SDOT(N*M,WORK(SSSI+N),1,WORK(SSSI+N),1)
         WORK(WSSI) = WORK(WSSEPI) + WORK(WSSDEI)
*
C  SELECT FIRST ROW OF X + DELTA THAT CONTAINS NO ZEROS
*
         NROW = -1
         CALL SSETN(N,M,WORK(XPLUSI),N,NROW)
         IWORK(NROWI) = NROW
*
C  SET NUMBER OF GOOD DIGITS IN FUNCTION RESULTS
*
         EPSMAC = WORK(EPSMAI)
         IF ((NDIGIT.LT.2) .OR.
     +       (NDIGIT.GT.INT(-LOG10(EPSMAC)))) THEN
            IWORK(NETAI) = -1
            NFEV = IWORK(NFEVI)
            CALL SETAF(FUN,NFEV,
     +                 N,NP,M,WORK(XPLUSI),N,
     +                 BETA,ETA,NETA,EPSMAC,
     +                 NROW,WORK(BETANI),WORK(FNI),ISTOPF)
            IWORK(NFEVI) = NFEV
            IF (ISTOPF.NE.0) THEN
               INFO = 53000
               IWORK(NETAI) = 0
               WORK(ETAI) = ZERO
               GO TO 20
            ELSE
               IWORK(NETAI) = NETA
               WORK(ETAI) = ETA
            END IF
         ELSE
            IWORK(NETAI) = NDIGIT
            WORK(ETAI) = TEN**(-NDIGIT)
         END IF
*
C  CHECK DERIVATIVES IF NECESSARY
*
         IF (CHKJAC .AND. ANAJAC) THEN
            NTOL = -1
            NFEV = IWORK(NFEVI)
            NJEV = IWORK(NJEVI)
            NETA = IWORK(NETAI)
            LDTT = IWORK(LDTTI)
            ETA = WORK(ETAI)
            EPSMAC = WORK(EPSMAI)
            CALL SJCK(FUN,JAC,NFEV,NJEV,
     +                N,NP,M,BETA,WORK(XPLUSI),N,
     +                ETA,NETA,NTOL,
     +                WORK(SSFI),WORK(TTI),LDTT,NROW,
     +                ISODR,EPSMAC,
     +                WORK(FNI),WORK(FJACBI),N,WORK(FJACXI),N,
     +                IWORK(MSGB),IWORK(MSGX),ISTOPF,ISTOPJ)
            IWORK(NFEVI) = NFEV
            IWORK(NJEVI) = NJEV
            IWORK(NTOLI) = NTOL
            IF (ISTOPF.NE.0) THEN
               INFO = 54000
            ELSE IF (ISTOPJ.NE.0) THEN
               INFO = 50200
            ELSE IF (IWORK(MSGB).NE.0 .OR. IWORK(MSGX).NE.0) THEN
               INFO = 40000
            END IF
         ELSE
*
C  INDICATE USER-SUPPLIED DERIVATIVES WERE NOT CHECKED
*
            IWORK(MSGB) = -1
            IWORK(MSGX) = -1
         END IF
      END IF
*
C  PRINT APPROPRIATE ERROR MESSAGES
*
   20 IF (INFO.NE.0) THEN
         IF (LUNERR.NE.0 .AND. IPRINT.NE.0) THEN
            CALL SODPER
     +         (INFO,LUNERR,SHORT,
     +         N,NP,M,
     +         LDSCLD,LDWD,
     +         LWKMN,LIWKMN,
     +         SCLD,SCLB,W,WD,
     +         IWORK(MSGB),ISODR,IWORK(MSGX),
     +         WORK(XPLUSI),N,IWORK(NROWI),IWORK(NETAI),IWORK(NTOLI))
         END IF
*
C  SET INFO TO REFLECT ERRORS IN THE USER-SUPPLIED JACOBIANS
*
         IF (INFO.EQ.40000) THEN
            IF (IWORK(MSGB).EQ.1 .OR. IWORK(MSGX).EQ.1) THEN
               IF (IWORK(MSGB).EQ.1) THEN
                  INFO = INFO + 1000
               END IF
               IF (IWORK(MSGX).EQ.1) THEN
                  INFO = INFO + 100
               END IF
            ELSE
               INFO = 0
            END IF
         END IF
         IF (INFO.NE.0) THEN
            RETURN
         END IF
      END IF
*
C  FIND LEAST SQUARES SOLUTION
*
      LDTT = IWORK(LDTTI)
      CALL SODMN(FUN,JAC,
     +           N,NP,M,
     +           X,LDX,IFIXX,LDIFX,Y,
     +           WORK(BETACI),IFIXB,BETA,WORK(BETANI),WORK(BETASI),
     +           WORK(SI),WORK(DELTAI),WORK(DELTNI),WORK(DELTSI),
     +           WORK(TI),WORK(FI),WORK(FNI),WORK(FSI),
     +           WORK(FJACBI),IWORK(MSGB),WORK(FJACXI),IWORK(MSGX),
     +           W,WD,LDWD,
     +           WORK(SSFI),WORK(SSI),WORK(TTI),LDTT,
     +           WORK(XPLUSI),WORK(DDELTI),WORK(SSSI),
     +           WORK,LWORK,IWORK,LIWORK,INFO)
*
      RETURN
*
      END
*SODLM
      SUBROUTINE SODLM
     +   (N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +   W,WD,LDWD,SS,TT,LDTT,DDELT,
     +   ALPHA2,TAU,EPSMAC,
     +   SSS,WRK1,TFJACB,OMEGA,YT,
     +   U,QRAUX,WRK2,JPVT,
     +   S,T,NLMS,RCOND,IRANK)
C***BEGIN PROLOGUE  SODLM
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SDIAGI,SDOT,SNRM2,SODSTP
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE LEVENBERG-MARQUARDT PARAMETER AND STEPS S AND T
C            USING ANALOG OF THE TRUST-REGION LEVENBERG-MARQUARDT
C            ALGORITHM
C***END PROLOGUE  SODLM
*
C...SCALAR ARGUMENTS
      REAL
     +   ALPHA2,EPSMAC,RCOND,TAU
      INTEGER
     +   IRANK,LDFJB,LDFJX,LDTT,LDWD,M,N,NLMS,NP,NPP
*
C...ARRAY ARGUMENTS
      REAL
     +   DDELT(N,M),F(N),FJACB(LDFJB,NP),FJACX(LDFJX,M),
     +   OMEGA(N),QRAUX(N),S(NP),SS(NP),
     +   SSS(N+N*M),T(N,M),TFJACB(N,NP),TT(LDTT,M),U(N),
     +   W(N),WD(LDWD,M),WRK1(N,M),WRK2(NP),YT(N)
      INTEGER
     +   JPVT(NP)
*
C...LOCAL SCALARS
      REAL
     +   ALPHA1,ALPHAN,BOT,P001,P1,PHI1,PHI2,SA,TOP,ZERO
      INTEGER
     +   I,J
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SDOT,SNRM2
      EXTERNAL
     +   SDOT,SNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SDIAGI,SODSTP
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MAX,MIN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P001,P1
     +   /0.0E0,0.001E0,0.1E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL ALPHAN
C        THE NEW LEVENBERG-MARQUARDT PARAMETER.
C     REAL ALPHA1
C        THE PREVIOUS LEVENBERG-MARQUARDT PARAMETER.
C     REAL ALPHA2
C        THE CURRENT LEVENBERG-MARQUARDT PARAMETER.
C     REAL BOT
C        THE LOWER LIMIT FOR SETTING ALPHA.
C     REAL DDELT(N,M)
C        THE ARRAY (W*D)**2 * DELTA.
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     REAL FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     REAL FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JPVT(NP)
C        THE PIVOT VECTOR.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NLMS
C        THE NUMBER OF LEVENBERG-MARQUARDT STEPS TAKEN.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL OMEGA(N)
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     REAL P001
C        THE VALUE 0.001E0
C     REAL P1
C        THE VALUE 0.1E0
C     REAL PHI1
C        THE PREVIOUS DIFFERENCE BETWEEN THE NORM OF THE SCALED STEP
C        AND THE TRUST REGION DIAMETER.
C     REAL PHI2
C        THE CURRENT DIFFERENCE BETWEEN THE NORM OF THE SCALED STEP
C        AND THE TRUST REGION DIAMETER.
C     REAL QRAUX(N)
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     REAL RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     REAL S(NP)
C        THE STEP FOR THE ESTIMATED BETA'S.
C     REAL SA
C        THE SCALAR PHI2*(ALPHA1-ALPHA2)/(PHI1-PHI2).
C     REAL SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SSS(N+N*M)
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     REAL T(N,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     REAL TAU
C        THE TRUST REGION DIAMETER.
C     REAL TFJACB(N,NP)
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     REAL TOP
C        THE UPPER LIMIT FOR SETTING ALPHA.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL U(N)
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WRK1(N,M)
C        A WORK ARRAY.
C     REAL WRK2(NP)
C        A WORK ARRAY.
C     REAL YT(N)
C         THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODLM
*
*
C  COMPUTE FULL GAUSS-NEWTON STEP (ALPHA=0)
*
      ALPHA1 = ZERO
      CALL SODSTP(N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +            W,WD,LDWD,SS,TT,LDTT,DDELT,
     +            ALPHA1,EPSMAC,
     +            SSS,TFJACB,WRK1,OMEGA,
     +            YT,U,QRAUX,WRK2,
     +            JPVT,S,T,PHI1,IRANK,
     +            RCOND)
*
C  INITIALIZE TAU IF NECESSARY
*
      IF (TAU.LT.ZERO) THEN
         TAU = ABS(TAU)*PHI1
      END IF
*
C  CHECK IF FULL GAUSS-NEWTON STEP IS OPTIMAL
*
      IF ((PHI1-TAU).LE.P1*TAU) THEN
         NLMS = 1
         ALPHA2 = ZERO
         RETURN
      END IF
*
C  FULL GAUSS-NEWTON STEP IS OUTSIDE TRUST REGION -
C  FIND LOCALLY CONSTRAINED OPTIMAL STEP
*
      PHI1 = PHI1 - TAU
*
C  INITIALIZE UPPER AND LOWER BOUNDS FOR ALPHA
*
      BOT = ZERO
*
      IF (NPP.GE.1) THEN
         DO 10 I=1,NPP
            SSS(I) = SDOT(N,FJACB(1,I),1,F,1)
   10    CONTINUE
         CALL SDIAGI(NPP,1,SS,NPP,SSS,NPP,SSS,NPP)
      END IF
      DO 30 J=1,M
         DO 20 I=1,N
            WRK1(I,J) = FJACX(I,J)*F(I) + DDELT(I,J)
   20    CONTINUE
   30 CONTINUE
      CALL SDIAGI(N,M,TT,LDTT,WRK1,N,SSS(1+NPP),N)
      TOP = SNRM2(NPP+N*M,SSS,1)/TAU
      IF (ALPHA2.GT.TOP .OR. ALPHA2.EQ.ZERO) THEN
         ALPHA2 = P001*TOP
      END IF
*
C  MAIN LOOP
*
      DO 40 I=1,10
*
C  COMPUTE LOCALLY CONSTRAINED STEPS S AND T AND PHI(ALPHA) FOR
C  CURRENT VALUE OF ALPHA
*
         CALL SODSTP(N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +               W,WD,LDWD,SS,TT,LDTT,DDELT,
     +               ALPHA2,EPSMAC,
     +               SSS,TFJACB,WRK1,OMEGA,
     +               YT,U,QRAUX,WRK2,
     +               JPVT,S,T,PHI2,IRANK,
     +               RCOND)
         PHI2 = PHI2-TAU
*
C  CHECK WHETHER CURRENT STEP IS OPTIMAL
*
         IF (ABS(PHI2).LE.P1*TAU .OR.
     +      (ALPHA2.EQ.BOT .AND. PHI2.LT.ZERO)) THEN
            NLMS = I+1
            RETURN
         END IF
*
C  CURRENT STEP IS NOT OPTIMAL
*
C  UPDATE BOUNDS FOR ALPHA AND COMPUTE NEW ALPHA
*
         IF (PHI1-PHI2.EQ.ZERO) THEN
            NLMS = 12
            RETURN
         END IF
         SA = PHI2*(ALPHA1-ALPHA2)/(PHI1-PHI2)
         IF (PHI2.LT.ZERO) THEN
            TOP = MIN(TOP,ALPHA2)
         ELSE
            BOT = MAX(BOT,ALPHA2)
         END IF
         IF (PHI1*PHI2.GT.ZERO) THEN
            BOT = MAX(BOT,ALPHA2-SA)
         ELSE
            TOP = MIN(TOP,ALPHA2-SA)
         END IF
*
         ALPHAN = ALPHA2 - SA*(PHI1+TAU)/TAU
         IF (ALPHAN.GE.TOP .OR. ALPHAN.LE.BOT) THEN
            ALPHAN = MAX(P001*TOP,SQRT(TOP*BOT))
         END IF
*
C  GET READY FOR NEXT ITERATION
*
         ALPHA1 = ALPHA2
         ALPHA2 = ALPHAN
         PHI1 = PHI2
   40 CONTINUE
*
C  SET NLMS TO INDICATE AN OPTIMAL STEP COULD NOT BE FOUND IN 10 TRYS
*
      NLMS = 12
*
      RETURN
      END
*SODMN
      SUBROUTINE SODMN
     +   (FUN,JAC,
     +   N,NP,M,
     +   X,LDX,IFIXX,LDIFX,Y,
     +   BETAC,IFIXB,BETA,BETAN,BETAS,S,
     +   DELTA,DELTAN,DELTAS,T,
     +   F,FN,FS,
     +   FJACB,MSGB,FJACX,MSGX,
     +   W,WD,LDWD,SSF,SS,TT,LDTT,
     +   XPLUSD,DDELT,SSS,
     +   WORK,LWORK,IWORK,LIWORK,INFO)
C***BEGIN PROLOGUE  SODMN
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SACCES,SCOPY,SDIAGS,SDIAGW,SDOT,SEVFUN,SEVJAC,
C                    SFLAGS,SIDTS,SNRM2,SODLM,SODPCR,SQRDC,SPODI,
C                    SSCAL,SUNPAC,SWDS,SXPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  ITERATIVELY COMPUTE LEAST SQUARES SOLUTION
C***END PROLOGUE  SODMN
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,LDIFX,LDTT,LDWD,LDX,LIWORK,LWORK,M,
     +   N,NP
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),BETAC(NP),BETAN(NP),BETAS(NP),
     +   DDELT(N,M),DELTA(N,M),DELTAN(N,M),DELTAS(N,M),
     +   F(N),FJACB(N,NP),FJACX(N,M),FN(N),FS(N),
     +   S(NP),SS(NP),SSF(NP),SSS(N+N*M),
     +   T(N,M),TT(LDTT,M),W(N),WD(LDWD,M),WORK(LWORK),
     +   X(LDX,M),XPLUSD(N,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),IWORK(LIWORK),MSGB(NP+1),MSGX(M+1)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      REAL
     +   ACTRED,ACTRS,ALPHA,DIRDER,EPSMAC,OLMAVG,ONE,
     +   P0001,P1,P25,P5,P75,PARTOL,PNORM,PRERED,PRERS,
     +   RATIO,RCOND,RNORM,RNORMN,RNORMS,RVAR,SSTOL,TAU,TAUFAC,
     +   TEMP,TEMP1,TEMP2,TSNORM,WSS,WSSDEL,WSSEPS,ZERO
      INTEGER
     +   I,IDF,IFLAG,INT2,IPR1,IPR2,IPR2F,IPR3,IRANK,ISTOPF,ISTOPJ,J,
     +   JOB,JPVT,JUNFIX,LUNRPT,MAXIT,NETA,NFEV,NITER,NJEV,NLMS,NNZW,
     +   NPP,OMEGA,QRAUX,TFJACB,U,WRK1,WRK2,YT
      LOGICAL
     +   ACCESS,ANAJAC,CHKJAC,CNVPAR,CNVSS,DIDVCV,DOVCV,FSTITR,HEAD,
     +   INITD,INTDBL,ISODR,LSTEP,RESTRT
*
C...LOCAL ARRAYS
      REAL
     +   W2(1)
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SDOT,SNRM2
      EXTERNAL
     +   SDOT,SNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SACCES,SCOPY,SDIAGS,SDIAGW,SEVFUN,SEVJAC,SFLAGS,SIDTS,
     +   SODLM,SODPCR,SQRDC,SPODI,SSCAL,SUNPAC,SWDS,SXPY
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MIN,MOD,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,P0001,P1,P25,P5,P75,ONE,W2(1)
     +   /0.0E0,0.00010E0,0.10E0,0.250E0,
     +   0.50E0,0.750E0,1.0E0,-1.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ACCESS
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER INFORMATION
C        IS TO BE ACCESSED FROM THE WORK ARRAYS (ACCESS=TRUE) OR
C        STORED IN THEM (ACCESS=FALSE).
C     REAL ACTRED
C        THE ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES OF THE
C        WEIGHTED OBSERVATIONAL ERRORS.
C     REAL ACTRS
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL BETAC(NP)
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     REAL BETAN(NP)
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     REAL BETAS(NP)
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     LOGICAL CNVPAR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER PARAMETER
C        CONVERGENCE HAS BEEN ATTAINED (CNVPAR=.TRUE.) OR NOT
C        (CNVPAR=.FALSE.).
C     LOGICAL CNVSS
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER SUM-OF-SQUARES
C        CONVERGENCE HAS BEEN ATTAINED (CNVSS=.TRUE.) OR NOT
C        (CNVSS=.FALSE.).
C     REAL DDELT(N,M)
C        THE ARRAY (W*D)**2 * DELTA.
C     REAL DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     REAL DELTAN(N,M)
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     REAL DELTAS(N,M)
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DIDVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX WAS COMPUTED (DIDVCV=.TRUE.)
C        OR NOT (DIDVCV=.FALSE.).
C     REAL DIRDER
C        THE DIRECTIONAL DERIVATIVE.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX SHOULD TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     REAL FJACB(N,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     REAL FJACX(N,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     REAL FN(N)
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     REAL FS(N)
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     LOGICAL FSTITR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THIS IS THE
C        FIRST ITERATION (FSTITR=.TRUE.) OR NOT (FSTITR=.FALSE.).
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFLAG
C        AN INDICATOR VARIABLE, USED TO SPECIFY WHICH COMPUTATION REPORT
C        IS TO BE PRINTED.
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER INT2
C        THE NUMBER OF INTERNAL DOUBLING STEPS TAKEN.
C     LOGICAL INTDBL
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER INTERNAL
C        DOUBLING IS TO BE USED (INTDBL=.TRUE.) OR NOT (INTDBL=.FALSE.).
C     INTEGER IPR1
C        THE VALUE OF THE FOURTH DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE INITIAL SUMMARY REPORT.
C     INTEGER IPR2
C        THE VALUE OF THE THIRD DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE ITERATION REPORTS.
C     INTEGER IPR2F
C        THE VALUE OF THE SECOND DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FREQUENCY OF THE ITERATION REPORTS.
C     INTEGER IPR3
C        THE VALUE OF THE FIRST DIGIT (FROM THE RIGHT) OF IPRINT,
C        WHICH CONTROLS THE FINAL SUMMARY REPORT.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER ISTOPJ
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE JACOBIAN GIVEN THE CURRENT ESTIMATES
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JPVT
C        THE STARTING LOCATION IN IWORK OF
C        THE PIVOT VECTOR.
C     INTEGER JUNFIX
C        THE INDEX OF THE NEXT UNFIXED PARAMETER.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL LSTEP
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER A SUCCESSFUL
C        STEP HAS BEEN FOUND (LSTEP=.TRUE.) OR NOT (LSTEP=.FALSE.).
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS TAKEN.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NLMS
C        THE NUMBER OF LEVENBERG-MARQUARDT STEPS TAKEN.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL OLMAVG
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGA
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL P0001
C        THE VALUE 0.0001E0.
C     REAL P1
C        THE VALUE 0.1E0.
C     REAL P25
C        THE VALUE 0.25E0.
C     REAL P5
C        THE VALUE 0.5E0.
C     REAL P75
C        THE VALUE 0.75E0.
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     REAL PRERED
C        THE PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL PRERS
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUX
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     REAL RATIO
C        THE RATIO OF THE ACTUAL RELATIVE REDUCTION TO THE PREDICTED
C        RELATIVE REDUCTION IN THE SUM-OF-SQUARES.
C     REAL RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     REAL RNORM
C        THE NORM OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL RNORMN
C        THE NORM OF THE NEW WEIGHTED OBSERVATIONAL ERRORS.
C     REAL RNORMS
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     REAL RVAR
C        THE RESIDUAL VARIANCE.
C     REAL S(NP)
C        THE STEP FOR THE ESTIMATED BETA'S.
C     REAL SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SSS(N+N*M)
C        THE WORK ARRAY USED PRIMARILY FOR COMPUTING VARIOUS
C        SUMS-OF-SQUARES.
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL T(N,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     REAL TAU
C        THE TRUST REGION DIAMETER.
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TEMP
C        A TEMPORARY STORAGE LOCATION.
C     REAL TEMP1
C        A TEMPORARY STORAGE LOCATION.
C     REAL TEMP2
C        A TEMPORARY STORAGE LOCATION.
C     INTEGER TFJACB
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB,
C        ALSO USED TO RETURN THE VARIANCE COVARIANCE MATRIX OF THE
C        ESTIMATORS OF THE PARAMETERS.
C     REAL TSNORM
C        THE NORM OF THE SCALED STEP.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER U
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WORK(LWORK)
C        THE REAL WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     REAL WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     REAL WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     REAL W2(1)
C        THE VALUE USED TO INDICATE THAT THE DEFAULT VALUE
C        OF THE OBSERVATIONAL ERROR WEIGHTS IS TO BE USED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER WRK1
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WRK2
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY,
C        ALSO USED TO RETURN THE STANDARD ERRORS FOR THE PARAMETERS.
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL XPLUSD(N,M)
C        THE ARRAY X + DELTA.
C     REAL Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER YT
C        THE STARTING LOCATION IN WORK OF
C        THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODMN
*
*
C  INITIALIZE NECESSARY VARIABLES
*
      ACCESS = .TRUE.
      CALL SACCES(N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +            ACCESS,
     +            JPVT,WRK1,TFJACB,OMEGA,YT,U,QRAUX,WRK2,
     +            NNZW,NPP,
     +            JOB,PARTOL,SSTOL,MAXIT,TAUFAC,EPSMAC,NETA,
     +            LUNRPT,IPR1,IPR2,IPR2F,IPR3,
     +            WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +            TAU,ALPHA,NITER,NFEV,NJEV,INT2,OLMAVG,
     +            RCOND,IRANK,ACTRS,PNORM,PRERS,RNORMS)
      RNORM = SQRT(WSS)
      CALL SFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
*
      DIDVCV = .FALSE.
      INTDBL = .FALSE.
      LSTEP = .TRUE.
      HEAD = .TRUE.
*
      FSTITR = .TRUE.
*
C  PRINT INITIAL SUMMARY IF DESIRED
*
      IF (IPR1.NE.0 .AND. LUNRPT.NE.0) THEN
         IFLAG = 1
         CALL SODPCR(HEAD,IFLAG,IPR1,FSTITR,DIDVCV,LUNRPT,
     +               MSGB,MSGX,
     +               N,M,NP,NPP,NNZW,
     +               X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +               BETA,IFIXB,SSF,WORK(WRK2),
     +               JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +               WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +               NITER,NFEV,NJEV,ACTRED,PRERED,
     +               TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
      END IF
*
C  STOP IF INITIAL ESTIMATES ARE EXACT SOLUTION
*
      IF (RNORM .EQ. ZERO) THEN
         INFO = 1
         OLMAVG = ZERO
         GO TO 40
      END IF
*
C  MAIN LOOP
*
   10 CONTINUE
*
      NITER = NITER + 1
      RNORMS = RNORM
*
C  EVALUATE JACOBIAN
*
      CALL SEVJAC(FUN,JAC,ANAJAC,N,NP,NPP,M,BETAC,BETA,
     +            IFIXB,IFIXX,LDIFX,
     +            X,LDX,DELTA,N,XPLUSD,N,
     +            SS,TT,LDTT,NETA,FN,SSS,
     +            FJACB,N,ISODR,FJACX,N,W,NJEV,NFEV,ISTOPJ)
      IF (ISTOPJ.NE.0) THEN
         INFO = 50100
         GO TO 200
      END IF
*
C  COMPUTE DDELT = (W*D)**2 * DELTA
*
      CALL SWDS(N,M,W,WD,LDWD,DELTA,N,DDELT,N)
      CALL SWDS(N,M,W,WD,LDWD,DDELT,N,DDELT,N)
*
C  SUB LOOP FOR
C     INTERNAL DOUBLING OR
C     COMPUTING NEW STEP WHEN OLD FAILED
*
   20 CONTINUE
*
C  COMPUTE STEPS S AND T
*
      CALL SODLM(N,NP,NPP,M,
     +           F,FJACB,N,FJACX,N,
     +           W,WD,LDWD,SS,TT,LDTT,DDELT,
     +           ALPHA,TAU,EPSMAC,
     +           SSS,WORK(WRK1),WORK(TFJACB),WORK(OMEGA),WORK(YT),
     +           WORK(U),WORK(QRAUX),WORK(WRK2),IWORK(JPVT),
     +           S,T,NLMS,RCOND,IRANK)
      OLMAVG = OLMAVG+NLMS
*
C  COMPUTE BETAN = BETAC + S
C          DELTAN = DELTA + T
*
      CALL SXPY(NPP,1,BETAC,NPP,S,NPP,BETAN,NPP)
      CALL SXPY(N,M,DELTA,N,T,N,DELTAN,N)
*
C  COMPUTE NORM OF SCALED STEPS S AND T (TSNORM)
*
      IF (NPP.GE.1) THEN
         CALL SDIAGS(NPP,1,SS,NPP,S,NPP,SSS,NPP)
      END IF
      CALL SDIAGS(N,M,TT,LDTT,T,N,SSS(NPP+1),N)
      TSNORM = SNRM2(NPP+N*M,SSS,1)
*
C  COMPUTE SCALED PREDICTED REDUCTION
*
      DO 30 I=1,N
        SSS(I) = SDOT(NPP,FJACB(I,1),N,S,1) +
     +           SDOT(M,FJACX(I,1),N,T(I,1),N)
   30 CONTINUE
      CALL SWDS(N,M,W,WD,LDWD,T,N,SSS(N+1),N)
      TEMP1 = SNRM2(N+N*M,SSS,1)/RNORM
      TEMP2 = SQRT(ALPHA)*TSNORM/RNORM
      PRERED = TEMP1**2+TEMP2**2/P5
*
      DIRDER = -(TEMP1**2+TEMP2**2)
*
C  EVALUATE WEIGHTED EPSILONS AT NEW POINT
*
      CALL SEVFUN(N,NP,M,BETAN,BETA,IFIXB,FUN,
     +            X,LDX,Y,DELTAN,N,XPLUSD,N,
     +            W,FN,NFEV,ISTOPF)
      IF (ISTOPF.LT.0) THEN
*
C  SET INFO TO INDICATE USER HAS STOPPED THE COMPUTATIONS IN FUN
*
         INFO = 51000
         GO TO 200
      ELSE IF (ISTOPF.GT.0) THEN
*
C  SET NORM TO INDICATE STEP SHOULD BE REJECTED
*
         RNORMN = RNORM/(P1*P75)
      ELSE
*
C  COMPUTE NORM OF NEW WEIGHTED EPSILONS AND WEIGHTED DELTAS (RNORMN)
*
         CALL SCOPY(N,FN,1,SSS,1)
         CALL SWDS(N,M,W,WD,LDWD,DELTAN,N,SSS(N+1),N)
         RNORMN = SNRM2(N+N*M,SSS,1)
      END IF
*
C  COMPUTE SCALED ACTUAL REDUCTION
*
      IF (P1*RNORMN.LT.RNORM) THEN
         ACTRED = ONE - (RNORMN/RNORM)**2
      ELSE
         ACTRED = -ONE
      END IF
*
C  COMPUTE RATIO OF ACTUAL REDUCTION TO PREDICTED REDUCTION
*
      IF(PRERED .EQ. ZERO) THEN
         RATIO = ZERO
      ELSE
         RATIO = ACTRED/PRERED
      END IF
*
C  CHECK ON LACK OF REDUCTION IN INTERNAL DOUBLING CASE
*
      IF (INTDBL .AND. (RATIO.LT.P0001 .OR. RNORMN.GT.RNORMS)) THEN
         TAU = TAU*P5
         ALPHA = ALPHA/P5
         CALL SCOPY(NPP,BETAS,1,BETAN,1)
         CALL SCOPY(N*M,DELTAS,1,DELTAN,1)
         CALL SCOPY(N,FS,1,FN,1)
         ACTRED = ACTRS
         PRERED = PRERS
         RNORMN = RNORMS
         RATIO = P5
      END IF
*
C  UPDATE STEP BOUND
*
      INTDBL = .FALSE.
      IF (RATIO.LT.P25) THEN
         IF (ACTRED.GE.ZERO) THEN
            TEMP = P5
         ELSE
            TEMP = P5*DIRDER/(DIRDER+P5*ACTRED)
         END IF
         IF (P1*RNORMN.GE.RNORM .OR. TEMP.LT.P1) THEN
            TEMP = P1
         END IF
         TAU = TEMP*MIN(TAU,TSNORM/P1)
         ALPHA = ALPHA/TEMP
*
      ELSE IF (ALPHA.EQ.ZERO) THEN
         TAU = TSNORM/P5
*
      ELSE IF (RATIO.GE.P75 .AND. NLMS.LE.11) THEN
*
C  STEP QUALIFIES FOR INTERNAL DOUBLING
C     - UPDATE TAU AND ALPHA
C     - SAVE INFORMATION FOR CURRENT POINT
*
         INTDBL = .TRUE.
*
         TAU = TSNORM/P5
         ALPHA = ALPHA*P5
*
         CALL SCOPY(NPP,BETAN,1,BETAS,1)
         CALL SCOPY(N*M,DELTAN,1,DELTAS,1)
         CALL SCOPY(N,FN,1,FS,1)
         ACTRS = ACTRED
         PRERS = PRERED
         RNORMS = RNORMN
      END IF
*
C  IF INTERNAL DOUBLING, SKIP CONVERGENCE CHECKS
*
      IF (INTDBL .AND. TAU.GT.ZERO) THEN
         INT2 = INT2+1
         GO TO 20
      END IF
*
C  CHECK ACCEPTANCE
*
      IF (RATIO.GE.P0001) THEN
         CALL SCOPY(N,FN,1,F,1)
         CALL SCOPY(NPP,BETAN,1,BETAC,1)
         CALL SCOPY(N*M,DELTAN,1,DELTA,1)
         RNORM = RNORMN
         IF (NPP.GE.1) THEN
            CALL SDIAGS(NPP,1,SS,NPP,BETAC,NPP,SSS,NPP)
         END IF
         CALL SDIAGS(N,M,TT,LDTT,DELTA,N,SSS(NPP+1),N)
         PNORM = SNRM2(NPP+N*M,SSS,1)
         LSTEP = .TRUE.
      ELSE
         LSTEP = .FALSE.
      END IF
*
C  TEST CONVERGENCE
*
      INFO = 0
      CNVSS = RNORM.EQ.ZERO
     +        .OR.
     +        (ABS(ACTRED).LE.SSTOL .AND.
     +         PRERED.LE.SSTOL      .AND.
     +         P5*RATIO.LE.ONE)
      CNVPAR = TAU.LE.PARTOL*PNORM
      IF (CNVSS)                            INFO = 1
      IF (CNVPAR)                           INFO = 2
      IF (CNVSS .AND. CNVPAR)               INFO = 3
*
C  PRINT ITERATION REPORT
*
      IF (INFO.NE.0 .OR. LSTEP) THEN
         IF (IPR2.NE.0 .AND. LUNRPT.NE.0) THEN
            IF (IPR2F.EQ.1 .OR. MOD(NITER,IPR2F).EQ.1) THEN
               IFLAG = 2
               CALL SUNPAC(NP,BETAC,BETA,IFIXB)
               WSS = RNORM*RNORM
               CALL SODPCR(HEAD,IFLAG,IPR2,FSTITR,DIDVCV,LUNRPT,
     +                     MSGB,MSGX,
     +                     N,M,NP,NPP,NNZW,
     +                     X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +                     BETA,IFIXB,SSF,WORK(WRK2),
     +                     JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +                     WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +                     NITER,NFEV,NJEV,ACTRED,PRERED,
     +                     TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
               FSTITR = .FALSE.
            END IF
         END IF
      END IF
*
C  CHECK IF FINISHED
*
      IF (INFO.EQ.0) THEN
         IF (LSTEP) THEN
*
C  BEGIN NEXT INTERATION UNLESS A STOPPING CRITERIA HAS BEEN MET
*
            IF (NITER.GE.MAXIT) THEN
               INFO = 4
            ELSE
               GO TO 10
            END IF
         ELSE
*
C  STEP FAILED - RECOMPUTE UNLESS A STOPPING CRITERIA HAS BEEN MET
*
            GO TO 20
         END IF
      END IF
*
   40 CONTINUE
*
      IF (ISTOPF.GT.0) INFO = INFO + 100
*
C  COMPUTE UNWEIGHTED EPSILONS AND X+DELTA TO RETURN TO USER
*
      CALL SEVFUN(N,NP,M,BETAC,BETA,IFIXB,FUN,
     +            X,LDX,Y,DELTA,N,XPLUSD,N,
     +            W2,F,NFEV,ISTOPF)
      IF (ISTOPF.LT.0) THEN
         INFO = 51000
         GO TO 200
      END IF
*
C  COMPUTE VARIANCE COVARIANCE MATRIX OF ESTIMATED PARAMETERS
C  IN UPPER TRIANGULAR PORTION OF WORK(TFJACB) IF REQUESTED
*
      IF (DOVCV .AND. IRANK.EQ.0 .AND. ISTOPF.EQ.0) THEN
*
C  EVALUATE JACOBIANS AT FINAL SOLUTION
*
         CALL SEVJAC(FUN,JAC,ANAJAC,N,NP,NPP,M,BETAC,BETA,
     +               IFIXB,IFIXX,LDIFX,
     +               X,LDX,DELTA,N,XPLUSD,N,
     +               SSF,TT,LDTT,NETA,FN,SSS,
     +               FJACB,N,ISODR,FJACX,N,W,NJEV,NFEV,ISTOPJ)
         IF (ISTOPJ.NE.0) THEN
            INFO = 50100
            GO TO 200
         END IF
         IDF = 0
         DO 70 I=1,N
            DO 50 J=1,NPP
               IF (FJACB(I,J).NE.ZERO) THEN
                  IDF = IDF + 1
                  GO TO 70
               END IF
   50       CONTINUE
            DO 60 J=1,M
               IF (FJACX(I,J).NE.ZERO) THEN
                  IDF = IDF + 1
                  GO TO 70
               END IF
   60       CONTINUE
   70    CONTINUE
*
         IF (ISODR) THEN
*
C  PROBLEM IS ODR --
C  SET UP OMEGA AND TFJACB
C  (VDTD = FJACX * INV(DT) WHERE DT = (W*D)**2)
*
            CALL SIDTS(N,M,
     +                 W,WD,LDWD,ZERO,TT,LDTT,FJACX,N,WORK(WRK1),N)
            DO 90 I=1,N
               WORK(OMEGA-1+I) =
     +            SQRT(ONE+SDOT(M,WORK(WRK1+I-1),N,FJACX(I,1),N))
               DO 80 J=1,NPP
                  WORK(TFJACB-1+I+(J-1)*N) = FJACB(I,J)/WORK(OMEGA-1+I)
   80          CONTINUE
   90       CONTINUE
*
         ELSE
*
C  PROBLEM IS OLS --
*
            CALL SCOPY(N*NPP,FJACB,1,WORK(TFJACB),1)
*
         END IF
*
         CALL SQRDC
     +      (WORK(TFJACB),N,N,NPP,WORK(QRAUX),IWORK(JPVT),WORK(WRK2),0)
         CALL SPODI
     +      (WORK(TFJACB),N,NPP,WORK(WRK2),1)
*
         IF (IDF.GT.NPP) THEN
            IDF = IDF - NPP
            RVAR = RNORM*RNORM/IDF
         ELSE
            IDF = 0
            RVAR = RNORM*RNORM
         END IF
*
         CALL SSCAL
     +      (N*NPP,RVAR,WORK(TFJACB),1)
         CALL SCOPY
     +      (NPP,WORK(TFJACB),N+1,WORK(WRK2),1)
         IF (NP.GT.NPP) THEN
            JUNFIX = NPP-1
            DO 100 J=NP-1,0,-1
               IF (IFIXB(J+1).EQ.0) THEN
                  WORK(WRK2+J) = ZERO
               ELSE
                  WORK(WRK2+J) = SQRT(WORK(WRK2+JUNFIX))
                  JUNFIX = JUNFIX - 1
               END IF
  100       CONTINUE
         ELSE
            DO 110 J=0,NP-1
               WORK(WRK2+J) = SQRT(WORK(WRK2+J))
  110       CONTINUE
         END IF
*
         DIDVCV = .TRUE.
*
      END IF
*
C  STORE VARIOUS SCALARS IN WORK ARRAYS FOR RETURN TO USER
*
  200 OLMAVG = OLMAVG/NITER
*
C  COMPUTE WEIGHTED EPSILONS AND WEIGHTED DELTAS FOR RETURN TO USER
*
      CALL SDIAGW(N,1,W,F,N,SSS,N)
      WSSEPS = SDOT(N,SSS,1,SSS,1)
      CALL SWDS(N,M,W,WD,LDWD,DELTA,N,SSS(N+1),N)
      WSSDEL = SDOT(N*M,SSS(N+1),1,SSS(N+1),1)
      WSS = WSSEPS + WSSDEL
*
C  COMPUTE ESTIMATED RESPONSE VARIABLE RETURN TO USER, I.E.,
C     EST<Y> = OBS<Y> + EST<EPSILON>
*
      CALL SXPY(N,1,Y,N,F,N,FN,N)
*
      ACCESS = .FALSE.
      CALL SACCES(N,M,NP,WORK,LWORK,IWORK,LIWORK,
     +            ACCESS,
     +            JPVT,WRK1,TFJACB,OMEGA,YT,U,QRAUX,WRK2,
     +            NNZW,NPP,
     +            JOB,PARTOL,SSTOL,MAXIT,TAUFAC,EPSMAC,NETA,
     +            LUNRPT,IPR1,IPR2,IPR2F,IPR3,
     +            WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +            TAU,ALPHA,NITER,NFEV,NJEV,INT2,OLMAVG,
     +            RCOND,IRANK,ACTRS,PNORM,PRERS,RNORMS)
*
C  ENCODE EXISTANCE OF QUESTIONABLE RESULTS INTO INFO
*
      IF (INFO.LE.9) THEN
         IF (MSGB(1).EQ.2 .OR. MSGX(1).EQ.2) THEN
            INFO = INFO + 1000
         END IF
         IF (ISTOPF.NE.0) THEN
            INFO = INFO + 100
         END IF
         IF (IRANK.GE.1) THEN
            IF (NPP.GT.IRANK) THEN
               INFO = INFO + 10
            ELSE
               INFO = INFO + 20
            END IF
         END IF
      END IF
*
C  PRINT FINAL SUMMARY
*
      IF (IPR3.NE.0 .AND. LUNRPT.NE.0) THEN
         IFLAG = 3
*
         CALL SODPCR(HEAD,IFLAG,IPR3,FSTITR,DIDVCV,LUNRPT,
     +               MSGB,MSGX,
     +               N,M,NP,NPP,NNZW,
     +               X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +               BETA,IFIXB,SSF,WORK(WRK2),
     +               JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +               WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +               NITER,NFEV,NJEV,ACTRED,PRERED,
     +               TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
      END IF
*
      RETURN
*
      END
*SODPC1
      SUBROUTINE SODPC1
     +   (IPR,LUNRPT,
     +   ANAJAC,CHKJAC,INITD,RESTRT,ISODR,DOVCV,
     +   MSGB,MSGX,
     +   N,M,NP,NPP,NNZW,
     +   X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,
     +   Y,W,
     +   BETA,IFIXB,SSF,
     +   JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +   WSS,WSSDEL,WSSEPS)
C***BEGIN PROLOGUE  SODPC1
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  NONE
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE INITIAL SUMMARY REPORT
C***END PROLOGUE  SODPC1
*
C...SCALAR ARGUMENTS
      REAL
     +   PARTOL,SSTOL,TAUFAC,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IPR,JOB,LDIFX,LDTT,LDWD,LDX,LUNRPT,M,MAXIT,N,NETA,NNZW,NP,NPP
      LOGICAL
     +   ANAJAC,CHKJAC,DOVCV,INITD,ISODR,RESTRT
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),DELTA(N,M),SSF(NP),TT(LDTT,M),W(N),WD(LDWD,M),
     +   X(LDX,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      REAL
     +   ONE,ZERO
      INTEGER
     +   J,K,L,NPLM1
      CHARACTER FMT1*90
*
C...LOCAL ARRAYS
      CHARACTER TEMPC(10)*5
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0E0,1.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     REAL DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     CHARACTER*90 FMT1
C        A CHARACTER VARIABLE USED FOR FORMATS.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER L
C        AN INDEXING VARIABLE.
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPLM1
C        THE NUMBER OF ITEMS TO PRINT PER LINE, MINUS ONE.
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     REAL SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     CHARACTER*5 TEMPC(10)
C        A TEMPORARY CHARACTER VECTOR.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     REAL WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     REAL WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPC1
*
*
C  PRINT PROBLEM SIZE SPECIFICATION
*
      WRITE (LUNRPT,1000) N,NNZW,M,NP,NPP
*
      IF (IPR.GE.2) THEN
*
C  PRINT INDEPENDENT VARIABLE DATA
*
         IF (ISODR) THEN
            WRITE (LUNRPT,2010)
         ELSE
            WRITE (LUNRPT,2020)
         END IF
         NPLM1 = 1
         DO 20 J = 1,M,NPLM1+1
            IF (.NOT.ISODR) THEN
               L = MIN(M,J+NPLM1) - J + 1
               WRITE (FMT1,7000) 6,L
               WRITE (LUNRPT,FMT1) (K,K=J,MIN(M,J+NPLM1))
               WRITE (FMT1,8000) 5,L
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,2100) (X(1,K),X(N,K),K=J,MIN(M,J+NPLM1))
            ELSE
               L = MIN(M,J+NPLM1) - J + 1
               WRITE (FMT1,7000) 20,L
               WRITE (LUNRPT,FMT1) (K,K=J,MIN(M,J+NPLM1))
               WRITE (FMT1,8000) 19,L
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,2200) (X(1,K),X(N,K),K=J,MIN(M,J+NPLM1))
               IF (IFIXX(1,1).LT.0) THEN
                  WRITE (LUNRPT,2300) ('   NO',K=1,2*L)
               ELSE
                  L = 0
                  DO 10 K=J,MIN(M,J+NPLM1)
                     L = L + 1
                     IF (IFIXX(1,K).EQ.0) THEN
                        TEMPC(2*L-1) = '  YES'
                     ELSE
                        TEMPC(2*L-1) = '   NO'
                     END IF
                     IF (LDIFX.EQ.1) THEN
                        IF (IFIXX(1,K).EQ.0) THEN
                           TEMPC(2*L) = '  YES'
                        ELSE
                           TEMPC(2*L) = '   NO'
                        END IF
                     ELSE
                        IF (IFIXX(N,K).EQ.0) THEN
                           TEMPC(2*L) = '  YES'
                        ELSE
                           TEMPC(2*L) = '   NO'
                        END IF
                     END IF
   10             CONTINUE
                  WRITE (LUNRPT,2300) (TEMPC(K),K=1,2*L)
               END IF
               WRITE (LUNRPT,2500) (DELTA(1,K),DELTA(N,K),
     +                              K=J,MIN(M,J+NPLM1))
               IF (TT(1,1).LT.0) THEN
                  WRITE (LUNRPT,2600) (ABS(TT(1,1)),ABS(TT(1,1)),
     +                                K=J,MIN(M,J+NPLM1))
               ELSE
                  IF (LDTT.EQ.1) THEN
                     WRITE (LUNRPT,2600) (TT(1,K),TT(1,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  ELSE
                     WRITE (LUNRPT,2600) (TT(1,K),TT(N,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  END IF
               END IF
               IF (WD(1,1).LT.0) THEN
                  WRITE (LUNRPT,2700) (ABS(WD(1,1)),ABS(WD(1,1)),
     +                                K=J,MIN(M,J+NPLM1))
               ELSE
                  IF (LDWD.EQ.1) THEN
                     WRITE (LUNRPT,2700) (WD(1,K),WD(1,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  ELSE
                     WRITE (LUNRPT,2700) (WD(1,K),WD(N,K),
     +                                    K=J,MIN(M,J+NPLM1))
                  END IF
               END IF
            END IF
   20    CONTINUE
*
C  PRINT DEPENDENT VARIABLE DATA AND OBSERVATION ERROR WEIGHTS
*
         WRITE (LUNRPT,3000)
         WRITE (FMT1,8000) 19,1
         WRITE (LUNRPT,FMT1)
         WRITE (LUNRPT,3100) Y(1),Y(N)
         IF (W(1).LT.ZERO) THEN
            WRITE (LUNRPT,3200) ONE,ONE
         ELSE
            WRITE (LUNRPT,3200) W(1),W(N)
         END IF
*
C  PRINT FUNCTION PARAMETER DATA
*
         WRITE (LUNRPT,4000)
         NPLM1 = 3
         DO 50 J=1,NP,NPLM1+1
            WRITE (LUNRPT,4100) (K,K=J,MIN(NP,J+NPLM1))
            WRITE (LUNRPT,4200) (BETA(K),K=J,MIN(NP,J+NPLM1))
            L = 0
            IF (IFIXB(1).LT.0) THEN
               DO 30 K=J,MIN(NP,J+NPLM1)
                  L = L + 1
                  TEMPC(L) = '   NO'
   30          CONTINUE
            ELSE
               DO 40 K=J,MIN(NP,J+NPLM1)
                  L = L + 1
                  IF (IFIXB(K).NE.0) THEN
                     TEMPC(L) = '   NO'
                  ELSE
                     TEMPC(L) = '  YES'
                  END IF
   40          CONTINUE
            END IF
            WRITE (LUNRPT,4300) (TEMPC(K),K=1,L)
            IF (SSF(1).LT.ZERO) THEN
               WRITE (LUNRPT,4400) (ABS(SSF(1)),K=J,MIN(NP,J+NPLM1))
            ELSE
               WRITE (LUNRPT,4400) (SSF(K),K=J,MIN(NP,J+NPLM1))
            END IF
   50    CONTINUE
      END IF
*
C  PRINT JOB SPECS AND STOPPING CRITERIA
*
      WRITE (LUNRPT,5000) JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT
      IF (RESTRT) THEN
         WRITE (LUNRPT,5110)
      ELSE
         WRITE (LUNRPT,5120)
      END IF
      IF (ISODR) THEN
         IF (INITD) THEN
            WRITE (LUNRPT,5211)
         ELSE
            WRITE (LUNRPT,5212)
         END IF
      ELSE
         WRITE (LUNRPT,5220)
      END IF
      IF (DOVCV) THEN
         WRITE (LUNRPT,5310)
      ELSE
         WRITE (LUNRPT,5320)
      END IF
      IF (ANAJAC) THEN
         WRITE (LUNRPT,5410)
         IF (CHKJAC) THEN
            WRITE (LUNRPT,5411)
            IF (MSGB(1).EQ.2 .OR. MSGX(1).EQ.2) THEN
               WRITE (LUNRPT,5412)
            ELSE
               WRITE (LUNRPT,5413)
            END IF
         ELSE
            WRITE (LUNRPT,5414)
         END IF
      ELSE
         WRITE (LUNRPT,5420)
      END IF
      IF (ISODR) THEN
         WRITE (LUNRPT,5510)
      ELSE
         WRITE (LUNRPT,5520)
      END IF
*
C  PRINT INITIAL SUM OF SQUARES
*
      WRITE (LUNRPT,6000)
      WRITE (LUNRPT,6100) WSS
      IF (ISODR) THEN
         WRITE (LUNRPT,6200) WSSDEL
         WRITE (LUNRPT,6300) WSSEPS
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1000 FORMAT
     +   (///' PROBLEM SIZE:'/
     +       ' -------------'//
     +       ' NUMBER OF OBSERVATIONS                            ',I5/
     +       ' NUMBER OF OBSERVATIONS WITH NONZERO WEIGHTS       ',I5/
     +       ' NUMBER OF COLUMNS OF DATA IN INDEPENDENT VARIABLE ',I5/
     +       ' NUMBER OF FUNCTION PARAMETERS                     ',I5/
     +       ' NUMBER OF UNFIXED FUNCTION PARAMETERS             ',I5)
 2010 FORMAT
     +   (///' INDEPENDENT VARIABLE AND DELTA WEIGHT SUMMARY:'/
     +       ' ----------------------------------------------')
 2020 FORMAT
     +   (///' INDEPENDENT VARIABLE SUMMARY:'/
     +       ' -----------------------------')
 2100 FORMAT
     +   (' X - ', 6E13.5)
 2200 FORMAT
     +   ('               X - ', 6E13.5)
 2300 FORMAT
     +   ('           FIXED - ', 6(8X,A5))
 2500 FORMAT
     +   ('   INITIAL DELTA - ', 6E13.5)
 2600 FORMAT
     +   ('     DELTA SCALE - ', 6E13.5)
 2700 FORMAT
     +   ('   DELTA WEIGHTS - ', 6E13.5)
 3000 FORMAT
     +   (///' DEPENDENT VARIABLE AND OBSERVATIONAL ERROR WEIGHT',
     +   ' SUMMARY:'/
     +       ' -------------------------------------------------',
     +   '---------'/)
 3100 FORMAT
     +   ('               Y - ', 6E13.5)
 3200 FORMAT
     +   (' OBS. ERROR WTS. - ', 6E13.5)
 4000 FORMAT
     +   (///' FUNCTION PARAMETER SUMMARY:'/
     +       ' ---------------------------')
 4100 FORMAT
     +   (/'        INDEX - ', 5I16)
 4200 FORMAT
     +   (' INITIAL BETA - ', 5E16.8)
 4300 FORMAT
     +   ('        FIXED - ', 5(11X,A5))
 4400 FORMAT
     +   ('   BETA SCALE - ', 5E16.8)
 5000 FORMAT
     +   (///' CONTROL VALUES AND STOPPING CRITERIA:'/
     +       ' --------------------------------------'//
     +       '       *                                     '/
     +       '    JOB    NDIGIT    TAUFAC     SSTOL    PARTOL  MAXIT'/
     +       1X,I6.5,5X,I5,3E10.2,I7//' *')
 5110 FORMAT
     +   ('  A.  FIT IS A RESTART.')
 5120 FORMAT
     +   ('  A.  FIT IS NOT A RESTART.')
 5211 FORMAT
     +   ('  B.  DELTAS ARE INITIALIZED TO ZERO.')
 5212 FORMAT
     +   ('  B.  DELTAS ARE INITIALIZED BY USER.')
 5220 FORMAT
     +   ('  B.  DELTAS ARE FIXED AT ZERO.')
 5310 FORMAT
     +   ('  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS'/
     +    '      WILL BE COMPUTED AT THE SOLUTION.')
 5320 FORMAT
     +   ('  C.  THE COVARIANCE MATRIX OF THE PARAMETER ESTIMATORS'/
     +    '      WILL NOT BE COMPUTED AT THE SOLUTION.')
 5410 FORMAT
     +   ('  D.  DERIVATIVES ARE SUPPLIED BY USER.')
 5411 FORMAT
     +   ('      USER-SUPPLIED DERIVATIVES WERE CHECKED.')
 5412 FORMAT
     +   ('      THE CORRECTNESS OF SOME OF THE DERIVATIVES IS'/
     +    '      QUESTIONABLE.  SEE ERROR MESSAGES FOR DETAILS.')
 5413 FORMAT
     +   ('      THE DERIVATIVES APPEAR TO BE CORRECT.')
 5414 FORMAT
     +   ('      USER-SUPPLIED DERIVATIVES WERE NOT CHECKED.')
 5420 FORMAT
     +   ('  D.  DERIVATIVES ARE COMPUTED BY FINITE DIFFERENCES.')
 5510 FORMAT
     +   ('  E.  FIT IS BY METHOD OF ORTHOGONAL DISTANCE REGRESSION.')
 5520 FORMAT
     +   ('  E.  FIT IS BY METHOD OF ORDINARY LEAST SQUARES.')
 6000 FORMAT
     +   (///' INITIAL SUMS OF SQUARES:'/
     +       ' ------------------------'/)
 6100 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS ', E17.8)
 6200 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED DELTAS               ', E17.8)
 6300 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED EPSILONS             ', E17.8)
 7000 FORMAT
     +   ('(/',I2,'X,',I2,'(''           COLUMN '',I3,''     ''))')
 8000 FORMAT
     +   ('(',I2,'X,',I2,'(''        OBS 1        OBS N''))')
      END
*SODPC2
      SUBROUTINE SODPC2
     +   (IPR,FSTITR,LUNRPT,NP,
     +   NITER,NFEV,WSS,ACTRED,PRERED,ALPHA,TAU,PNORM,BETA)
C***BEGIN PROLOGUE  SODPC2
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE ITERATION REPORTS
C***END PROLOGUE  SODPC2
*
C...SCALAR ARGUMENTS
      REAL
     +   ACTRED,ALPHA,PNORM,PRERED,TAU,WSS
      INTEGER
     +   IPR,LUNRPT,NFEV,NITER,NP
      LOGICAL
     +   FSTITR
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP)
*
C...LOCAL SCALARS
      REAL
     +   RATIO,ZERO
      INTEGER
     +   J,K,L
      CHARACTER GN*3
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL ACTRED
C        THE ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL FSTITR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THIS IS THE
C        FIRST ITERATION (FSTITR=.TRUE.) OR NOT (FSTITR=.FALSE.).
C     CHARACTER*3 GN
C        THE CHARACTER VARIABLE USED TO INDICATE WHETHER A GAUSS-NEWTON
C        STEP WAS TAKEN.
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER L
C        AN INDEXING VARIABLE.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     REAL PRERED
C        THE PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL RATIO
C        THE RATIO OF TAU TO PNORM.
C     REAL TAU
C        THE TRUST REGION DIAMETER.
C     REAL WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPC2
*
*
      IF (FSTITR) THEN
         IF (IPR.EQ.1) THEN
            WRITE (LUNRPT,1120)
         ELSE
            WRITE (LUNRPT,1130)
         END IF
      END IF
      IF (ALPHA.EQ.ZERO) THEN
         GN = 'YES'
      ELSE
         GN = ' NO'
      END IF
      IF (PNORM.NE.ZERO) THEN
         RATIO = TAU/PNORM
      ELSE
         RATIO = ZERO
      END IF
      IF (IPR.EQ.1) THEN
         WRITE (LUNRPT,1141) NITER,NFEV,WSS,ACTRED,PRERED,
     +                       RATIO,GN
      ELSE
         J = 1
         K = MIN(3,NP)
         IF (J.EQ.K) THEN
            WRITE (LUNRPT,1141) NITER,NFEV,WSS,ACTRED,PRERED,
     +                          RATIO,GN,J,BETA(J)
         ELSE
            WRITE (LUNRPT,1142) NITER,NFEV,WSS,ACTRED,PRERED,
     +                          RATIO,GN,J,K,(BETA(L),L=J,K)
         END IF
         IF (NP.GT.3) THEN
            DO 10 J=4,NP,3
               K = MIN(J+2,NP)
               IF (J.EQ.K) THEN
                  WRITE (LUNRPT,1151) J,BETA(J)
               ELSE
                  WRITE (LUNRPT,1152) J,K,(BETA(L),L=J,K)
               END IF
   10       CONTINUE
         END IF
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1120 FORMAT
     +   (//
     +    '         CUM.                 ACT. REL.   PRED. REL.'/
     +    '  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS',
     +    '              G-N'/
     +    ' NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION',
     +    '  TAU/PNORM  STEP'/
     +    ' ----  ------  -----------  -----------  -----------',
     +    '  ---------  ----'/)
 1130 FORMAT
     +   (//
     +    '         CUM.                 ACT. REL.   PRED. REL.'/
     +    '  IT.  NO. FN     WEIGHTED   SUM-OF-SQS   SUM-OF-SQS',
     +    '              G-N      BETA -------------->'/
     +    ' NUM.   EVALS   SUM-OF-SQS    REDUCTION    REDUCTION',
     +    '  TAU/PNORM  STEP     INDEX           VALUE'/
     +    ' ----  ------  -----------  -----------  -----------',
     +    '  ---------  ----     -----           -----'/)
 1141 FORMAT
     +   (1X,I4,I8,1X,E12.5,2E13.4,E11.3,3X,A3,7X,I3,3E16.8)
 1142 FORMAT
     +   (1X,I4,I8,1X,E12.5,2E13.4,E11.3,3X,A3,1X,I3,' TO',I3,3E16.8)
 1151 FORMAT
     +   (76X,I3,E16.8)
 1152 FORMAT
     +   (70X,I3,' TO',I3,3E16.8)
      END
*SODPC3
      SUBROUTINE SODPC3
     +   (IPR,LUNRPT,
     +   N,M,NP,NPP,
     +   INFO,NITER,NFEV,NJEV,RCOND,IRANK,
     +   WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +   BETA,SDBETA,IFIXB,F,ISODR,DIDVCV,DOVCV,ANAJAC,DELTA)
C***BEGIN PROLOGUE  SODPC3
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  NONE
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE FINAL SUMMARY REPORT
C***END PROLOGUE  SODPC3
*
C...SCALAR ARGUMENTS
      REAL
     +   RCOND,RVAR,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IDF,INFO,IPR,IRANK,LUNRPT,M,N,NFEV,NITER,NJEV,NP,NPP
      LOGICAL
     +   ANAJAC,DIDVCV,DOVCV,ISODR
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),DELTA(N,M),F(N),SDBETA(NP)
      INTEGER
     +   IFIXB(NP)
*
C...LOCAL SCALARS
      INTEGER
     +   D1,D2,D3,D4,D5,I,J,K,L,LAST,MAXLST,NPLM1
      CHARACTER FMT1*90
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MIN,MOD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER D1
C        THE FIRST DIGIT OF INFO.
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER D4
C        THE FOURTH DIGIT OF INFO.
C     INTEGER D5
C        THE FIFTH DIGIT OF INFO.
C     REAL DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DIDVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX WAS COMPUTED (DIDVCV=.TRUE.)
C        OR NOT (DIDVCV=.FALSE.).
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     REAL F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     CHARACTER*90 FMT1
C        A CHARACTER VARIABLE USED FOR FORMATS.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER L
C        AN INDEXING VARIABLE.
C     INTEGER LAST
C        THE LAST ROW OF THE GIVEN ARRAY TO BE PRINTED.
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXLST
C        THE MAXIMUM NUMBER OF ITEMS TO BE PRINTED.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPLM1
C        THE NUMBER OF ITEMS TO BE PRINTED PER LINE, MINUS ONE.
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     REAL RVAR
C        THE RESIDUAL VARIANCE.
C     REAL SDBETA(NP)
C        THE STANDARD ERRORS OF THE ESTIMATED PARAMETERS.
C     REAL WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     REAL WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     REAL WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPC3
*
*
      D1 = INFO/10000
      D2 = MOD(INFO,10000)/1000
      D3 = MOD(INFO,1000)/100
      D4 = MOD(INFO,100)/10
      D5 = MOD(INFO,10)
*
C  PRINT STOPPING CONDITIONS
*
      WRITE (LUNRPT,1000) INFO
      IF (D1.EQ.5) THEN
         IF (D2.NE.0) THEN
            WRITE (LUNRPT,1110)
         ELSE IF (D3.NE.0) THEN
            WRITE (LUNRPT,1115)
         END IF
      ELSE
         IF (D5.EQ.1) THEN
            WRITE (LUNRPT,1120)
         ELSE IF (D5.EQ.2) THEN
            WRITE (LUNRPT,1130)
         ELSE IF (D5.EQ.3) THEN
            WRITE (LUNRPT,1140)
         ELSE IF (D5.EQ.4) THEN
            WRITE (LUNRPT,1150)
         ELSE
            WRITE (LUNRPT,1160)
         END IF
*
C  PRINT WARNING DIAGNOSTICS
*
         IF (D2.NE.0 .OR. D3.NE.0 .OR. D4.NE.0) THEN
            WRITE (LUNRPT,1210)
            IF (D2.NE.0) THEN
               IF (D3.NE.0 .OR. D4.NE.0) THEN
                  WRITE (LUNRPT,1220) ', AND'
               ELSE
                  WRITE (LUNRPT,1220) '.    '
               END IF
            END IF
            IF (D3.NE.0) THEN
               IF (D4.NE.0) THEN
                  WRITE (LUNRPT,1230) ', AND'
               ELSE
                  WRITE (LUNRPT,1230) '.    '
               END IF
            END IF
            IF (D4.EQ.1) THEN
               WRITE (LUNRPT,1240)
            END IF
            IF (D4.EQ.2) THEN
               WRITE (LUNRPT,1250)
            END IF
         END IF
      END IF
*
C  PRINT MISC. STOPPING INFO
*
      IF (ANAJAC) THEN
         WRITE (LUNRPT,1300) NITER,NFEV,NJEV,RCOND,IRANK
      ELSE
         WRITE (LUNRPT,1400) NITER,NFEV,RCOND,IRANK
      END IF
*
C  PRINT FINAL SUM OF SQUARES
*
      WRITE (LUNRPT,2000)
      WRITE (LUNRPT,2100) WSS
      IF (ISODR) THEN
         WRITE (LUNRPT,2200) WSSDEL
         WRITE (LUNRPT,2300) WSSEPS
      END IF
      IF (DIDVCV) THEN
         WRITE (LUNRPT,2400) RVAR
         WRITE (LUNRPT,2500) IDF
      END IF
*
      NPLM1 = 3
*
C  PRINT ESTIMATED BETA'S, AND,
C  IF, FULL RANK, THEIR STANDARD ERRORS
*
      WRITE (LUNRPT,3000)
      IF (DIDVCV) THEN
         WRITE (LUNRPT,7300)
*
         DO 10 J=1,NP
            IF (NP.EQ.NPP) THEN
               WRITE (LUNRPT,8100) J,BETA(J),SDBETA(J)
            ELSE
               IF (IFIXB(J).EQ.0) THEN
                  WRITE (LUNRPT,8400) J,BETA(J)
               ELSE
                  WRITE (LUNRPT,8100) J,BETA(J),SDBETA(J)
               END IF
            END IF
   10    CONTINUE
      ELSE
         IF (DOVCV) WRITE (LUNRPT,7400)
         IF (NP.EQ.1) THEN
            WRITE (LUNRPT,7100)
         ELSE
            WRITE (LUNRPT,7200)
         END IF
*
         DO 20 J=1,NP,NPLM1+1
            K = MIN(J+NPLM1,NP)
            IF (K.EQ.J) THEN
               WRITE (LUNRPT,8100) J,BETA(J)
            ELSE
               WRITE (LUNRPT,8200) J,K,(BETA(L),L=J,K)
            END IF
   20    CONTINUE
      END IF
*
C  PRINT ESTIMATED EPSILON'S AND DELTA'S
*
      MAXLST = 32
      IF (IPR.GE.2 .OR. N.LT.MAXLST) THEN
         LAST = N
      ELSE
         LAST = MAXLST
      END IF
*
C  PRINT EPSILON'S AND DELTA'S TOGETHER IN A COLUMN IF THE NUMBER OF
C  COLUMNS OF DATA IN DELTA IS LESS THAN OR EQUAL TO THREE.
*
      IF (ISODR .AND. M.LE.3) THEN
         WRITE (LUNRPT,4100)
         WRITE (FMT1,9100) M
         WRITE (LUNRPT,FMT1) (J,J=1,M)
         DO 30 I=1,LAST
            WRITE (LUNRPT,4110) I,F(I),(DELTA(I,J),J=1,M)
   30    CONTINUE
         IF (N.GT.LAST) THEN
            IF (N.LE.LAST+4) THEN
               DO 40 I=LAST+1,N
                  WRITE (LUNRPT,4110) I,F(I),(DELTA(I,J),J=1,M)
   40          CONTINUE
            ELSE
               WRITE (FMT1,9200) M+1
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,FMT1)
               WRITE (LUNRPT,4110) N,F(N),(DELTA(N,J),J=1,M)
            END IF
         END IF
      ELSE
*
C  PRINT EPSILON'S AND DELTA'S SEPARATELY
*
C  PRINT EPSILON'S
*
         WRITE (LUNRPT,4200)
         IF (LAST.EQ.1) THEN
            WRITE (LUNRPT,7100)
         ELSE
            WRITE (LUNRPT,7200)
         END IF
         DO 50 I=1,LAST,NPLM1+1
            K = MIN(I+NPLM1,LAST)
            IF (I.EQ.K) THEN
               WRITE (LUNRPT,8100) I,F(I)
            ELSE
               WRITE (LUNRPT,8200) I,K,(F(L),L=I,K)
            END IF
   50    CONTINUE
         IF (N.GT.LAST) THEN
            IF (N.EQ.LAST+1) THEN
               WRITE (LUNRPT,8100) N,F(N)
            ELSE IF (N.GT.LAST+1) THEN
               WRITE (LUNRPT,8300) N,F(N)
            END IF
         END IF
*
C  PRINT DELTA'S
*
         IF (ISODR) THEN
            DO 70 J=1,M
               WRITE (LUNRPT,4300) J
               IF (LAST.EQ.1) THEN
                  WRITE (LUNRPT,7100)
               ELSE
                  WRITE (LUNRPT,7200)
               END IF
               DO 60 I=1,LAST,NPLM1+1
                  K = MIN(I+NPLM1,LAST)
                  IF (I.EQ.K) THEN
                     WRITE (LUNRPT,8100) I,DELTA(I,J)
                  ELSE
                     WRITE (LUNRPT,8200) I,K,(DELTA(L,J),L=I,K)
                  END IF
   60          CONTINUE
               IF (N.EQ.LAST+1) THEN
                  WRITE (LUNRPT,8100) N,DELTA(N,J)
               ELSE IF (N.GT.LAST+1) THEN
                  WRITE (LUNRPT,8300) N,DELTA(N,J)
               END IF
   70       CONTINUE
         END IF
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1000 FORMAT
     +   (///' STOPPING CONDITION (INFO = ',I6,'):'/
     +       ' -----------------------------------'/)
 1110 FORMAT
     +   (   ' THE COMPUTATIONS WERE STOPPED BY THE USER DURING'/
     +       ' THE EVALUATION OF THE FUNCTION')
 1115 FORMAT
     +   (   ' THE COMPUTATIONS WERE STOPPED BY THE USER DURING'/
     +       ' THE EVALUATION OF THE JACOBIAN')
 1120 FORMAT
     +   (   ' THE RELATIVE CHANGE IN THE SUM OF THE SQUARED'/
     +       ' WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL')
 1130 FORMAT
     +   (   ' THE RELATIVE CHANGE IN THE NORM OF BETA AND DELTA'/
     +       ' IS LESS THAN PARTOL')
 1140 FORMAT
     +   (   ' THE RELATIVE CHANGE IN THE SUM OF THE SQUARED'/
     +       ' WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL'/
     +       ' AND'/
     +       ' THE RELATIVE CHANGE IN THE NORM OF BETA AND DELTA'/
     +       ' IS LESS THAN PARTOL')
 1150 FORMAT
     +   (   ' MAXIMUM NUMBER OF ITERATIONS REACHED')
 1160 FORMAT
     +   (   ' ERROR.  PLEASE CHECK WITH AUTHORS.')
 1210 FORMAT
     +   (/  ' NOTE:'//
     +       ' THE RESULTS FROM ODRPACK ARE QUESTIONABLE BECAUSE'/)
 1220 FORMAT
     +   (   ' THE ODRPACK JACOBIAN MATRIX CHECKING PROCEDURE HAS  '/
     +       ' DETERMINED THAT THE CORRECTNESS OF THE USER-SUPPLIED'/
     +       ' JACOBIAN MATRICES IS QUESTIONABLE',A5/)
 1230 FORMAT
     +   (   ' THE MOST RECENTLY TRIED STEP WAS REJECTED BY THE    '/
     +       ' USER AS INDICATED BY THE VALUE OF VARIABLE ISTOPF   '/
     +       ' RETURNED FROM USER-SUPPLIED SUBROUTINE FUN',A5/)
 1240 FORMAT
     +   (   ' THE JACOBIAN OF THE MODEL FUNCTION WITH RESPECT TO  '/
     +       ' THE FUNCTION PARAMETERS (BETA) IS NOT FULL RANK AT  '/
     +       ' THE SOLUTION. ')
 1250 FORMAT
     +   (   ' THE RESULTS OF THE MODEL FUNCTION AND/OR ITS        '/
     +       ' DERIVATIVES ARE UNAFFECTED BY CHANGES IN THE UNFIXED'/
     +       ' FUNCTION PARAMETERS (BETA), INDICATING A PROBABLE   '/
     +       ' ERROR IN USER-SUPPLIED SUBROUTINES FUN AND/OR JAC.'/)
 1300 FORMAT
     +  (/'                                       CONDITION',
     +       '            '/
     +    '       NUMBER OF  NUMBER OF  NUMBER OF    NUMBER',
     +       '        RANK'/
     +    '      ITERATIONS   FN EVALS  JAC EVALS (INVERSE)',
     +       '  DEFICIENCY'/
     +    6X,I10,2I11,E11.4,6X,I6)
 1400 FORMAT
     +  (/'                             CONDITION            '/
     +    '       NUMBER OF  NUMBER OF     NUMBER        RANK'/
     +    '      ITERATIONS   FN EVALS  (INVERSE)  DEFICIENCY'/
     +    6X,I10,I11,E11.4,6X,I6)
 2000 FORMAT
     +   (///' FINAL SUMS OF SQUARES:'/
     +       ' ----------------------'/)
 2100 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS ', E17.8)
 2200 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED DELTAS               ', E17.8)
 2300 FORMAT
     +   (   ' SUM OF SQUARED WEIGHTED EPSILONS             ', E17.8)
 2400 FORMAT
     +   (/  ' ESTIMATED RESIDUAL VARIANCE                  ', E17.8)
 2500 FORMAT
     +   (   ' (',I5,' DEGREES OF FREEDOM)')
 3000 FORMAT
     +   (///' ESTIMATED BETA(J), J = 1, ..., NP:'/
     +       ' ----------------------------------')
 4100 FORMAT
     +   (///' ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:'/
     +       ' ---------------------------------------------------')
 4110 FORMAT(1X,I5,5E16.8)
 4200 FORMAT
     +   (///' ESTIMATED EPSILON(I), I = 1, ..., N:'/
     +      ' ------------------------------------')
 4300 FORMAT
     +   (///' ESTIMATED DELTA(I,',I3,'), I = 1, ..., N:'/
     +      ' --------------------------------------')
 7100 FORMAT
     +   (/'         INDEX            VALUE')
 7200 FORMAT
     +   (/'         INDEX            VALUE -------------->')
 7300 FORMAT
     +   (/'             J          BETA(J)     STD. DEV. BETA(J)')
 7400 FORMAT
     +   (/' N.B. STANDARD ERRORS OF THE ESTIMATED BETAS WERE NOT'/
     +     '      COMPUTED BECAUSE EITHER THE JACOBIAN IS NOT FULL'/
     +     '      RANK AT THE SOLUTION, OR THE MOST RECENTLY TRIED'/
     +     '      VALUES OF BETA AND/OR X+DELTA WERE UNACCEPTABLE.')
 8100 FORMAT
     +   (9X,I5,1X,E16.8,6X,E16.8)
 8200 FORMAT
     +   (1X,I5,' TO',I5,1X,7E16.8)
 8300 FORMAT
     +   (1X,'  ... TO',I5,1X,'      ...       ',E16.8)
 8400 FORMAT
     +   (9X,I5,1X,E16.8,17X,'FIXED')
 9100 FORMAT
     +   ('(/''     I      EPSILON(I)'',',I1,
     +    '(''      DELTA(I,'',I1,'')''))')
 9200 FORMAT('(5X,''.'',',I1,'(3X,''.'',12X))')
      END
*SODPCR
      SUBROUTINE SODPCR
     +   (HEAD,IFLAG,IPR,FSTITR,DIDVCV,LUNRPT,
     +   MSGB,MSGX,
     +   N,M,NP,NPP,NNZW,
     +   X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,Y,W,
     +   BETA,IFIXB,SSF,SDBETA,
     +   JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +   WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +   NITER,NFEV,NJEV,ACTRED,PRERED,
     +   TAU,PNORM,ALPHA,F,RCOND,IRANK,INFO)
C***BEGIN PROLOGUE  SODPCR
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SFLAGS,SODPC1,SODPC2,SODPC3,SODPHD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE COMPUTATION REPORTS
C***END PROLOGUE  SODPCR
*
C...SCALAR ARGUMENTS
      REAL
     +   ACTRED,ALPHA,PARTOL,PNORM,PRERED,RCOND,RVAR,
     +   SSTOL,TAU,TAUFAC,WSS,WSSDEL,WSSEPS
      INTEGER
     +   IDF,IFLAG,INFO,IPR,IRANK,JOB,LDIFX,LDTT,LDWD,LDX,LUNRPT,M,
     +   MAXIT,N,NETA,NFEV,NITER,NJEV,NNZW,NP,NPP
      LOGICAL
     +   ANAJAC,CHKJAC,DIDVCV,DOVCV,FSTITR,HEAD,INITD,ISODR,RESTRT
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),DELTA(N,M),F(N),
     +   SDBETA(NP),SSF(NP),TT(LDTT,M),W(N),WD(LDWD,M),X(LDX,M),
     +   Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      CHARACTER TYP*3
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SFLAGS,SODPC1,SODPC2,SODPC3,SODPHD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL ACTRED
C        THE ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     LOGICAL ANAJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE JACOBIANS
C        ARE COMPUTED BY FINITE DIFFERENCES (ANAJAC=.FALSE.) OR NOT
C        (ANAJAC=.TRUE.).
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL CHKJAC
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER-
C        SUPPLIED JACOBIANS ARE TO BE CHECKED (CHKJAC=.TRUE.) OR NOT
C        (CHKJAC=.FALSE.).
C     REAL DELTA(N,M)
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     LOGICAL DIDVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX WAS COMPUTED (DIDVCV=.TRUE.)
C        OR NOT (DIDVCV=.FALSE.).
C     LOGICAL DOVCV
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE
C        VARIANCE COVARIANCE MATRIX IS TO BE COMPUTED (DOVCV=.TRUE.)
C        OR NOT (DOVCV=.FALSE.).
C     REAL F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     LOGICAL FSTITR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THIS IS THE
C        FIRST ITERATION (FSTITR=.TRUE.) OR NOT (FSTITR=.FALSE.).
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER IDF
C        THE DEGREES OF FREEDOM OF THE FIT, EQUAL TO THE NUMBER OF
C        OBSERVATIONS WITH NONZERO WEIGHTED DERIVATIVES MINUS THE
C        NUMBER OF PARAMETERS BEING ESTIMATED.
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFLAG
C        AN INDICATOR VARIABLE, USED HERE TO DESIGNATE WHICH PART OF
C        THE REPORT IS TO BE PRINTED.
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C     LOGICAL INITD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE DELTA'S
C        ARE TO BE INITIALIZED TO ZERO (INITD=.TRUE.) OR WHETHER THEY
C        ARE TO BE INITIALIZED TO THE VALUES PASSED VIA THE FIRST N BY M
C        ELEMENTS OF ARRAY WORK (INITD=.FALSE.).
C     INTEGER IPR
C        THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS.
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NITER
C        THE NUMBER OF ITERATIONS.
C     INTEGER NJEV
C        THE NUMBER OF JACOBIAN EVALUATIONS.
C     INTEGER NNZW
C        THE NUMBER OF NONZERO OBSERVATIONAL ERROR WEIGHTS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL PNORM
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     REAL PRERED
C        THE PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     REAL RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     LOGICAL RESTRT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE CALL IS
C        A RESTART (RESTRT=TRUE) OR NOT (RESTRT=FALSE).
C     REAL RVAR
C        THE RESIDUAL VARIANCE.
C     REAL SDBETA(NP)
C        THE STANDARD DEVIATIONS OF THE ESTIMATED BETA'S.
C     REAL SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TAU
C        THE TRUST REGION DIAMETER.
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     CHARACTER*3 TYP
C        THE CHARACTER STRING ODR OR OLS.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WSS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     REAL WSSDEL
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     REAL WSSEPS
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  SODPCR
*
*
      CALL SFLAGS(JOB,RESTRT,INITD,ANAJAC,CHKJAC,ISODR,DOVCV)
*
      IF (HEAD) THEN
         CALL SODPHD(HEAD,LUNRPT)
      ELSE IF (IFLAG.NE.2 .OR. FSTITR) THEN
         WRITE (LUNRPT,1000)
      END IF
      IF (ISODR) THEN
         TYP = 'ODR'
      ELSE
         TYP = 'OLS'
      END IF
*
C  PRINT INITIAL SUMMARY
*
      IF (IFLAG.EQ.1) THEN
         IF (RESTRT) THEN
            WRITE (LUNRPT,1100) TYP
         ELSE
            WRITE (LUNRPT,1200) TYP
            CALL SODPC1
     +         (IPR,LUNRPT,
     +         ANAJAC,CHKJAC,INITD,RESTRT,ISODR,DOVCV,
     +         MSGB,MSGX,
     +         N,M,NP,NPP,NNZW,
     +         X,LDX,IFIXX,LDIFX,DELTA,WD,LDWD,TT,LDTT,
     +         Y,W,
     +         BETA,IFIXB,SSF,
     +         JOB,NETA,TAUFAC,SSTOL,PARTOL,MAXIT,
     +         WSS,WSSDEL,WSSEPS)
         END IF
*
C  PRINT ITERATION REPORTS
*
      ELSE IF (IFLAG.EQ.2) THEN
*
         IF (FSTITR) THEN
            WRITE (LUNRPT,1300) TYP
         END IF
         CALL SODPC2
     +      (IPR,FSTITR,LUNRPT,NP,
     +      NITER,NFEV,WSS,ACTRED,PRERED,ALPHA,TAU,PNORM,BETA)
*
C  PRINT FINAL SUMMARY
*
      ELSE IF (IFLAG.EQ.3) THEN
*
         WRITE (LUNRPT,1400) TYP
         CALL SODPC3
     +      (IPR,LUNRPT,
     +      N,M,NP,NPP,
     +      INFO,NITER,NFEV,NJEV,RCOND,IRANK,
     +      WSS,WSSDEL,WSSEPS,RVAR,IDF,
     +      BETA,SDBETA,IFIXB,F,ISODR,DIDVCV,DOVCV,ANAJAC,DELTA)
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1000 FORMAT(//)
 1100 FORMAT
     +   (////' RESTART OF FIT BY METHOD OF ',A3/
     +     ' ===============================')
 1200 FORMAT
     +   (////' INITIAL SUMMARY FOR FIT BY METHOD OF ',A3/
     +     ' ========================================')
 1300 FORMAT
     +   (//' ITERATION REPORTS FOR FIT BY METHOD OF ',A3/
     +     ' ==========================================')
 1400 FORMAT
     +   (////' FINAL SUMMARY FOR FIT BY METHOD OF ',A3/
     +     ' ======================================')
      END
*SODPE1
      SUBROUTINE SODPE1
     +   (UNIT,D1,D2,D3,D4,D5,
     +   N,
     +   LDSCLD,LDWD,
     +   LWKMN,LIWKMN)
C***BEGIN PROLOGUE  SODPE1
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PRINT ERROR REPORTS.
C***END PROLOGUE  SODPE1
*
C...SCALAR ARGUMENTS
      INTEGER
     +   D1,D2,D3,D4,D5,LDSCLD,LDWD,LIWKMN,LWKMN,N,UNIT
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER D1
C        THE FIRST DIGIT OF INFO.
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER D4
C        THE FOURTH DIGIT OF INFO.
C     INTEGER D5
C        THE FIFTH DIGIT OF INFO.
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPE1
*
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN PROBLEM SPECIFICATION
C  PARAMETERS
*
      IF (D1.EQ.1) THEN
         IF (D2.NE.0) THEN
            WRITE(UNIT,1100)
         END IF
         IF (D3.NE.0) THEN
            WRITE(UNIT,1200)
         END IF
         IF (D4.NE.0) THEN
            WRITE(UNIT,1300)
         END IF
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN DIMENSION SPECIFICATION
C  PARAMETERS
*
      ELSE IF (D1.EQ.2) THEN
         IF (D2.NE.0) THEN
            WRITE(UNIT,2100)
         END IF
         IF (D3.NE.0) THEN
            IF (D3.EQ.1 .OR. D3.EQ.3 .OR. D3.EQ.5 .OR. D3.EQ.7) THEN
               WRITE(UNIT,2210)
            END IF
            IF (D3.EQ.2 .OR. D3.EQ.3 .OR. D3.EQ.6 .OR. D3.EQ.7) THEN
               WRITE(UNIT,2220)
            END IF
            IF (D3.EQ.4 .OR. D3.EQ.5 .OR. D3.EQ.6 .OR. D3.EQ.7) THEN
               WRITE(UNIT,2230)
            END IF
         END IF
         IF (D4.NE.0) THEN
            WRITE(UNIT,2300) LWKMN
         END IF
         IF (D5.NE.0) THEN
            WRITE(UNIT,2400) LIWKMN
         END IF
*
      ELSE IF (D1.EQ.3) THEN
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS SCALE VALUES
*
         IF (D2.NE.0) THEN
            IF (LDSCLD.GE.N) THEN
               WRITE(UNIT,3110)
            ELSE
               WRITE(UNIT,3120)
            END IF
         END IF
         IF (D3.NE.0) THEN
            WRITE(UNIT,3130)
         END IF
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN OBSERVATIONAL ERROR WEIGHTS
*
         IF (D4.NE.0) THEN
            IF (D4.EQ.1) THEN
               WRITE(UNIT,3210)
            ELSE
               WRITE(UNIT,3220)
            END IF
         END IF
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN DELTA WEIGHTS
*
         IF (D5.NE.0) THEN
            IF (LDWD.GE.N) THEN
               WRITE(UNIT,3310)
            ELSE
               WRITE(UNIT,3320)
            END IF
         END IF
*
      END IF
*
C  FORMAT STATEMENTS
*
 1100 FORMAT
     +   (/' ERROR :  N IS LESS THAN ONE.')
 1200 FORMAT
     +   (/' ERROR :  M IS LESS THAN ONE.')
 1300 FORMAT
     +   (/' ERROR :  NP IS LESS THAN ONE'/
     +     '          OR NP IS GREATER THAN N.')
 2100 FORMAT
     +   (/' ERROR :  LDX IS LESS THAN N.')
 2210 FORMAT
     +   (/' ERROR :  LDIFX IS LESS THAN N'/
     +     '          AND LDIFX IS NOT EQUAL TO ONE.')
 2220 FORMAT
     +   (/' ERROR :  LDSCLD IS LESS THAN N'/
     +     '          AND LDSCLD IS NOT EQUAL TO ONE.')
 2230 FORMAT
     +   (/' ERROR :  LDWD IS LESS THAN N'/
     +     '          AND LDWD IS NOT EQUAL TO ONE.')
 2300 FORMAT
     +   (/' ERROR :  LWORK IS LESS THAN ',I5, ','/
     +     '          THE SMALLEST ACCEPTABLE DIMENSION OF ARRAY WORK.')
 2400 FORMAT
     +   (/' ERROR :  LIWORK IS LESS THAN ',I5, ','/
     +     '          THE SMALLEST ACCEPTABLE DIMENSION OF ARRAY',
     +              ' IWORK.')
 3110 FORMAT
     +   (/' ERROR :  SCLD(I,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME I = 1, ..., N AND J = 1, ..., M.'//
     +     '          WHEN SCLD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDSCLD IS GREATER THAN OR EQUAL TO N THEN'/
     +     '          EACH OF THE N BY M ELEMENTS OF'/
     +     '          SCLD MUST BE GREATER THAN ZERO.')
 3120 FORMAT
     +   (/' ERROR :  SCLD(1,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME J = 1, ..., M.'//
     +     '          WHEN SCLD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDSCLD IS EQUAL TO ONE THEN'/
     +     '          EACH OF THE 1 BY M ELEMENTS OF'/
     +     '          SCLD MUST BE GREATER THAN ZERO.')
 3130 FORMAT
     +   (/' ERROR :  SCLB(K) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME K = 1, ..., NP.'//
     +     '          ALL NP ELEMENTS OF',
     +              ' SCLB MUST BE GREATER THAN ZERO.')
 3210 FORMAT
     +   (/' ERROR :  W(I) IS LESS THAN ZERO FOR SOME I = 1, ..., N.'//
     +     '          WHEN W(1) IS GREATER THAN OR EQUAL TO ZERO THEN'/
     +     '          ALL N ELEMENTS OF',
     +              ' W MUST BE GREATER THAN OR EQUAL TO ZERO.')
 3220 FORMAT
     +   (/' ERROR :  THE NUMBER OF NONZERO VALUES IN ARRAY W IS'/
     +     '          LESS THAN NP.')
 3310 FORMAT
     +   (/' ERROR :  WD(I,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME I = 1, ..., N AND J = 1, ..., M.'//
     +     '          WHEN WD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDWD IS GREATER THAN OR EQUAL TO N THEN'/
     +     '          EACH OF THE N BY M ELEMENTS OF'/
     +     '          WD MUST BE GREATER THAN ZERO.')
 3320 FORMAT
     +   (/' ERROR :  WD(1,J) IS LESS THAN OR EQUAL TO ZERO'/
     +     '          FOR SOME J = 1, ..., M.'//
     +     '          WHEN WD(1,1) IS GREATER THAN ZERO'/
     +     '          AND LDWD IS EQUAL TO ONE THEN'/
     +     '          EACH OF THE 1 BY M ELEMENTS OF'/
     +     '          WD MUST BE GREATER THAN ZERO.')
      END
*SODPE2
      SUBROUTINE SODPE2
     +   (UNIT,
     +   NP,M,
     +   MSGB,ISODR,MSGX,
     +   XPLUSD,LDXPD,NROW,NETA,NTOL)
C***BEGIN PROLOGUE  SODPE2
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  GENERATE THE DERIVATIVE CHECKING REPORT
C            (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE DCKZRO)
C***END PROLOGUE  SODPE2
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDXPD,M,NETA,NP,NROW,NTOL,UNIT
      LOGICAL
     +   ISODR
*
C...ARRAY ARGUMENTS
      REAL
     +   XPLUSD(LDXPD,M)
      INTEGER
     +   MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      INTEGER
     +   I,J,K
      CHARACTER TYP*3
*
C...LOCAL ARRAYS
      LOGICAL
     +   FTNOTE(6)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL FTNOTE(6)
C        THE ARRAY WHICH CONTROLS PRINTING OF FOOTNOTES.
C     INTEGER I
C        AN INDEX VARIABLE.
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER K
C        AN INDEX VARIABLE.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER NETA
C        THE NUMBER OF RELIABLE DIGITS IN THE MODEL.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        FINITE DIFFERENCE AND THE USER-SUPPLIED DERIVATIVES.
C     CHARACTER*3 TYP
C        THE SOLUTION TYPE, ODR OR OLS.
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPE2
*
*
C  SET UP FOR FOOTNOTES
*
      DO 10 I=1,6
         FTNOTE(I) = .FALSE.
   10 CONTINUE
*
      IF (MSGB(1).GE.1) THEN
         DO 20 I=1,NP
            IF (MSGB(I+1).GE.2) THEN
               FTNOTE(1) = .TRUE.
               FTNOTE(MSGB(I+1)) = .TRUE.
            END IF
   20    CONTINUE
      END IF
*
      IF (MSGX(1).GE.1) THEN
         DO 30 I=1,M
            IF (MSGX(I+1).GE.2) THEN
               FTNOTE(1) = .TRUE.
               FTNOTE(MSGX(I+1)) = .TRUE.
            END IF
   30    CONTINUE
      END IF
*
C     PRINT REPORT
*
      IF (ISODR) THEN
         TYP = 'ODR'
      ELSE
         TYP = 'OLS'
      END IF
      WRITE (UNIT,1000) TYP
      IF (FTNOTE(1)) WRITE (UNIT,2100)
      WRITE (UNIT,2200)
*
*
      DO 40 I=1,NP
         K = MSGB(I+1) - 1
         IF (K.EQ.(-1)) WRITE (UNIT,3100) I
         IF (K.EQ.0) WRITE (UNIT,3200) I
         IF (K.GE.1) WRITE (UNIT,3300) I, K
   40 CONTINUE
      IF (ISODR) THEN
         DO 50 I=1,M
            K = MSGX(I+1) - 1
            IF (K.EQ.(-1)) WRITE (UNIT,4100) NROW,I
            IF (K.EQ.0) WRITE (UNIT,4200) NROW,I
            IF (K.GE.1) WRITE (UNIT,4300) NROW,I,K
   50    CONTINUE
      END IF
*
C     PRINT FOOTNOTES
*
      IF (FTNOTE(1)) THEN
*
         WRITE (UNIT,5100)
         IF (FTNOTE(2)) WRITE (UNIT,5200)
         IF (FTNOTE(3)) WRITE (UNIT,5300)
         IF (FTNOTE(4)) WRITE (UNIT,5400)
         IF (FTNOTE(5)) WRITE (UNIT,5500)
         IF (FTNOTE(6)) WRITE (UNIT,5600)
      END IF
*
      WRITE (UNIT,6000) NETA
      WRITE (UNIT,7000) NTOL
*
C  PRINT OUT ROW OF INDEPENDENT VARIABLE WHICH WAS CHECKED.
*
      WRITE (UNIT,8100) NROW
*
      DO 60 J=1,M
         WRITE (UNIT,8110) NROW,J,XPLUSD(NROW,J)
   60 CONTINUE
*
      RETURN
*
C     FORMAT STATEMENTS
*
 1000 FORMAT
     +   (//' DERIVATIVE CHECKING REPORT FOR FIT BY METHOD OF ',A3/
     +     ' ==================================================='/)
 2100 FORMAT ('                                    *')
 2200 FORMAT ('                          DERIVATIVE '/
     +        '       DERIVATIVE WRT     ASSESSMENT '/)
 3100 FORMAT ('            BETA(',I3,')         OK     ')
 3200 FORMAT ('            BETA(',I3,')      INCORRECT  ')
 3300 FORMAT ('            BETA(',I3,')    QUESTIONABLE (',I1,')')
 4100 FORMAT ('             X(',I2,',',I2,')         OK     ')
 4200 FORMAT ('             X(',I2,',',I2,')      INCORRECT  ')
 4300 FORMAT ('             X(',I2,',',I2,')    QUESTIONABLE (',I1,')')
 5100 FORMAT
     +   (/' *'/
     +     '  NUMBERS IN PARENTHESES REFER TO THE FOLLOWING NOTES.')
 5200 FORMAT
     +   (/'  (1) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      AGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE BOTH'/
     +     '      ARE ZERO.')
 5300 FORMAT
     +   (/'  (2) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      AGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE USER-'/
     +     '      SUPPLIED DERIVATIVE IS IDENTICALLY ZERO AND FINITE '/
     +     '      DIFFERENCE DERIVATIVE IS ONLY APPROXIMATELY ZERO.')
 5400 FORMAT
     +   (/'  (3) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      DISAGREE, BUT RESULTS ARE QUESTIONABLE BECAUSE'/
     +     '      USER-SUPPLIED DERIVATIVE IS IDENTICALLY ZERO.')
 5500 FORMAT
     +   (/'  (4) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      DISAGREE, BUT FINITE DIFFERENCE DERIVATIVE IS'/
     +     '      QUESTIONABLE BECAUSE EITHER THE RATIO OF RELATIVE'/
     +     '      CURVATURE TO RELATIVE SLOPE IS TOO HIGH OR THE SCALE'/
     +     '      IS WRONG.')
 5600 FORMAT
     +   (/'  (5) USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVES'/
     +     '      DISAGREE, BUT FINITE DIFFERENCE DERIVATIVE IS'/
     +     '      QUESTIONABLE BECAUSE THE RATIO OF RELATIVE CURVATURE'/
     +     '      TO RELATIVE SLOPE IS TOO HIGH.')
 6000 FORMAT
     *   (/' NUMBER OF RELIABLE DIGITS IN FUNCTION RESULTS       ',I5)
 7000 FORMAT
     +   (/' NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN      '/
     +     ' USER-SUPPLIED AND FINITE DIFFERENCE DERIVATIVE FOR  '/
     +     ' USER-SUPPLIED DERIVATIVE TO BE CONSIDERED CORRECT   ',I5)
 8100 FORMAT
     +   (/' ROW NUMBER AT WHICH DERIVATIVES WERE CHECKED        ',I5//
     +     '   -VALUES OF THE INDEPENDENT VARIABLES AT THIS ROW'/)
 8110 FORMAT
     +   (6X,'X(',I2,',',I2,')',1X,3E16.8)
      END
*SODPE3
      SUBROUTINE SODPE3
     +   (UNIT,D2,D3)
C***BEGIN PROLOGUE  SODPE3
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PRINT ERROR REPORTS TO INDICATE THAT COMPUTATIONS WERE
C            STOPPED IN USER-SUPPLIED SUBROUTINES FUN AND/OR JAC.
C***END PROLOGUE  SODPE3
*
C...SCALAR ARGUMENTS
      INTEGER
     +   D2,D3,UNIT
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPE3
*
*
C  PRINT APPROPRIATE MESSAGES TO INDICATE WHERE COMPUTATIONS WERE
C  STOPPED
*
      IF (D2.EQ.2) THEN
         WRITE(UNIT,1100)
      ELSE IF (D2.EQ.3) THEN
         WRITE(UNIT,1200)
      ELSE IF (D2.EQ.4) THEN
         WRITE(UNIT,1300)
      END IF
      IF (D3.EQ.2) THEN
         WRITE(UNIT,1400)
      END IF
*
C  FORMAT STATEMENTS
*
 1100 FORMAT
     +   (//' VARIABLE ISTOPF HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE FUN WHEN INVOKED USING THE'/
     +      ' INITIAL ESTIMATES OF BETA AND DELTA SUPPLIED BY THE     '/
     +      ' USER.  THE INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW  '/
     +      ' PROPER EVALUATION OF SUBROUTINE FUN BEFORE THE          '/
     +      ' REGRESSION PROCEDURE CAN CONTINUE.')
 1200 FORMAT
     +   (//' VARIABLE ISTOPF HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE FUN.  THIS OCCURRED DURING'/
     +      ' THE COMPUTATION OF THE NUMBER OF RELIABLE DIGITS IN THE '/
     +      ' PREDICTED VALUES (F) RETURNED FROM SUBROUTINE FUN, INDI-'/
     +      ' CATING THAT CHANGES IN THE INITIAL ESTIMATES OF BETA(K),'/
     +      ' K=1,NP, AS SMALL AS 2*BETA(K)*SQRT(MACHINE PRECISION),  '/
     +      ' WHERE MACHINE PRECISION IS DEFINED AS THE SMALLEST VALUE'/
     +      ' E SUCH THAT 1+E>1 ON THE COMPUTER BEING USED, PREVENT   '/
     +      ' SUBROUTINE FUN FROM BEING PROPERLY EVALUATED.  THE      '/
     +      ' INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW PROPER      '/
     +      ' EVALUATION OF SUBROUTINE FUN DURING THESE COMPUTATIONS  '/
     +      ' BEFORE THE REGRESSION PROCEDURE CAN CONTINUE.')
 1300 FORMAT
     +   (//' VARIABLE ISTOPF HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE FUN.  THIS OCCURRED DURING'/
     +      ' THE DERIVATIVE CHECKING PROCEDURE, INDICATING THAT      '/
     +      ' CHANGES IN THE INITIAL ESTIMATES OF BETA(K), K=1,NP, AS '/
     +      ' SMALL AS MAX[BETA(K),1/SCLB(K)]*10**(-NETA/2), AND/OR   '/
     +      ' OF DELTA(I,J), I=1,N AND J=1,M, AS SMALL AS             '/
     +      ' MAX[DELTA(I,J),1/SCLD(I,J)]*10**(-NETA/2), WHERE NETA   '/
     +      ' IS DEFINED TO BE THE NUMBER OF RELIABLE DIGITS IN       '/
     +      ' PREDICTED VALUES (F) RETURNED FROM SUBROUTINE FUN,      '/
     +      ' PREVENT SUBROUTINE FUN FROM BEING PROPERLY EVALUATED.   '/
     +      ' THE INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW PROPER  '/
     +      ' EVALUATION OF SUBROUTINE FUN DURING THESE COMPUTATIONS  '/
     +      ' BEFORE THE REGRESSION PROCEDURE CAN CONTINUE.')
 1400 FORMAT
     +   (//' VARIABLE ISTOPJ HAS BEEN RETURNED WITH A NONZERO VALUE  '/
     +      ' FROM USER-SUPPLIED SUBROUTINE JAC WHEN INVOKED USING THE'/
     +      ' INITIAL ESTIMATES OF BETA AND DELTA SUPPLIED BY THE     '/
     +      ' USER.  THE INITIAL ESTIMATES MUST BE ADJUSTED TO ALLOW  '/
     +      ' PROPER EVALUATION OF SUBROUTINE JAC BEFORE THE          '/
     +      ' REGRESSION PROCEDURE CAN CONTINUE.')
      END
*SODPER
      SUBROUTINE SODPER
     +   (INFO,LUNERR,SHORT,
     +   N,NP,M,
     +   LDSCLD,LDWD,
     +   LWKMN,LIWKMN,
     +   SCLD,SCLB,W,WD,
     +   MSGB,ISODR,MSGX,
     +   XPLUSD,LDXPD,NROW,NETA,NTOL)
C***BEGIN PROLOGUE  SODPER
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SODPE1,SODPE2,SODPE3,SODPHD
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  CONTROLLING ROUTINE FOR PRINTING ERROR REPORTS.
C***END PROLOGUE  SODPER
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,LDSCLD,LDWD,LDXPD,LIWKMN,LUNERR,LWKMN,M,N,NETA,NP,
     +   NROW,NTOL
      LOGICAL
     +   ISODR,SHORT
*
C...ARRAY ARGUMENTS
      REAL
     +   SCLB(NP),SCLD(LDSCLD,M),W(N),WD(LDWD,M),XPLUSD(LDXPD,M)
      INTEGER
     +   MSGB(NP+1),MSGX(M+1)
*
C...LOCAL SCALARS
      INTEGER
     +   D1,D2,D3,D4,D5,UNIT
      LOGICAL
     +   HEAD
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SODPE1,SODPE2,SODPE3,SODPHD
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER D1
C        THE FIRST DIGIT OF INFO.
C     INTEGER D2
C        THE SECOND DIGIT OF INFO.
C     INTEGER D3
C        THE THIRD DIGIT OF INFO.
C     INTEGER D4
C        THE FOURTH DIGIT OF INFO.
C     INTEGER D5
C        THE FIFTH DIGIT OF INFO.
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL ISODR
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION
C        IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.).
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER LIWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY IWORK.
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MSGB(NP+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT BETA.
C     INTEGER MSGX(M+1)
C        THE ERROR CHECKING RESULTS FOR THE JACOBIAN WRT X.
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NETA
C        THE NUMBER OF RELIABLE DIGITS IN THE MODEL.
C     REAL SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     INTEGER NTOL
C        THE NUMBER OF DIGITS OF AGREEMENT REQUIRED BETWEEN THE
C        FINITE DIFFERENCE AND THE USER-SUPPLIED DERIVATIVES.
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPER
*
*
C  SET LOGICAL UNIT NUMBER FOR ERROR REPORT
*
      IF (LUNERR.EQ.0) THEN
         RETURN
      ELSE IF (LUNERR.LT.0) THEN
         UNIT = 6
      ELSE
         UNIT = LUNERR
      END IF
*
C  PRINT HEADING
*
      HEAD = .TRUE.
      CALL SODPHD(HEAD,UNIT)
*
C  EXTRACT INDIVIDUAL DIGITS FROM VARIABLE INFO
*
      D1 = MOD(INFO,100000)/10000
      D2 = MOD(INFO,10000)/1000
      D3 = MOD(INFO,1000)/100
      D4 = MOD(INFO,100)/10
      D5 = MOD(INFO,10)
*
C  PRINT APPROPRIATE ERROR MESSAGES FOR ODRPACK INVOKED STOP
*
      IF (D1.GE.1 .AND. D1.LE.3) THEN
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS IN
C     PROBLEM SPECIFICATION PARAMETERS
C     DIMENSION SPECIFICATION PARAMETERS
C     NUMBER OF GOOD DIGITS IN X
C     OBSERVATIONAL ERROR WEIGHTS
C     DELTA WEIGHTS
*
         CALL SODPE1(UNIT,D1,D2,D3,D4,D5,
     +               N,
     +               LDSCLD,LDWD,
     +               LWKMN,LIWKMN)
*
      ELSE IF (D1.EQ.4) THEN
*
C  PRINT APPROPRIATE MESSAGES FOR ERRORS DETECTED IN THE USER-SUPPLIED
C  JACOBIAN
*
         CALL SODPE2(UNIT,
     +                NP,M,
     +                MSGB,ISODR,MSGX,
     +                XPLUSD,LDXPD,NROW,NETA,NTOL)
*
      ELSE IF (D1.EQ.5) THEN
*
C  PRINT APPROPRIATE ERROR MESSAGE FOR USER INVOKED STOP FROM FUN OR JAC
*
         CALL SODPE3(UNIT,D2,D3)
*
      END IF
*
C  PRINT CORRECT FORM OF CALL STATEMENT
*
      IF ((D1.GE.1 .AND. D1.LE.3) .OR.
     +    (D1.EQ.4 .AND. (D2.EQ.2 .OR. D3.EQ.2)) .OR.
     +    (D1.EQ.5)) THEN
         IF (SHORT) THEN
            WRITE (UNIT,1100)
         ELSE
            WRITE (UNIT,1200)
         END IF
      END IF
*
      RETURN
*
C  FORMAT STATEMENTS
*
 1100 FORMAT
     +   (//' THE CORRECT FORM OF THE CALL STATEMENT IS '//
     +      '       CALL SODR'/
     +      '      +     (FUN,JAC,'/
     +      '      +     N,M,NP,'/
     +      '      +     X,LDX,'/
     +      '      +     Y,'/
     +      '      +     BETA,'/
     +      '      +     WD,LDWD,'/
     +      '      +     JOB,'/
     +      '      +     IPRINT,LUNERR,LUNRPT,'/
     +      '      +     WORK,LWORK,IWORK,LIWORK,'/
     +      '      +     INFO)')
 1200 FORMAT
     +   (//' THE CORRECT FORM OF THE CALL STATEMENT IS '//
     +      '       CALL SODRC'/
     +      '      +     (FUN,JAC,'/
     +      '      +     N,M,NP,'/
     +      '      +     X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,'/
     +      '      +     Y,'/
     +      '      +     BETA,IFIXB,SCLB,'/
     +      '      +     WD,LDWD,W,'/
     +      '      +     JOB,NDIGIT,TAUFAC,'/
     +      '      +     SSTOL,PARTOL,MAXIT,'/
     +      '      +     IPRINT,LUNERR,LUNRPT,'/
     +      '      +     WORK,LWORK,IWORK,LIWORK,'/
     +      '      +     INFO)')
*
      END
*SODPHD
      SUBROUTINE SODPHD
     +   (HEAD,UNIT)
C***BEGIN PROLOGUE  SODPHD
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890727   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  PRINT ODRPACK HEADING
C***END PROLOGUE  SODPHD
*
C...SCALAR ARGUMENTS
      INTEGER
     +   UNIT
      LOGICAL
     +   HEAD
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL HEAD
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE PACKAGE
C        HEADING IS TO BE PRINTED (HEAD=.TRUE.) OR NOT (HEAD=.FALSE.).
C     INTEGER UNIT
C        THE LOGICAL UNIT NUMBER TO WHICH THE HEADING IS WRITTEN.
*
*
C***FIRST EXECUTABLE STATEMENT  SODPHD
*
*
      IF (HEAD) THEN
         WRITE(UNIT,1000)
         HEAD = .FALSE.
      END IF
*
      RETURN
*
C   FORMAT STATEMENTS
*
 1000 FORMAT (///
     +   ' ******************************************************* '/
     +   ' * ODRPACK VERSION 1.71 OF 07-27-89 (SINGLE PRECISION) * '/
     +   ' ******************************************************* '/)
      END
*SODR
      SUBROUTINE SODR
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,
     +   Y,
     +   BETA,
     +   WD,LDWD,
     +   JOB,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
C***BEGIN PROLOGUE  SODR
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  USER-CALLABLE SINGLE PRECISION CONTROL ROUTINE FOR FINDING
C            THE WEIGHTED ORTHOGONAL DISTANCE REGRESSION (ODR) OR
C            ORDINARY LINEAR OR NONLINEAR LEAST SQUARES (OLS) SOLUTION
C            (SHORT CALL STATEMENT)
C***DESCRIPTION
C      REFERENCE FOR ONLINE DOCUMENTATION IS GIVEN BELOW.
C      THE ONLINE DOCUMENTATION CAN BE INSERTED HERE IF REQUIRED BY
C      YOUR DOCUMENTATION RETRIEVAL SYSTEM.  ONLINE DOCUMENTATION DOES
C      NOT EXTEND BEYOND COLUMN 80, AND COLUMN 1 OF ONLINE
C      DOCUMENTATION CAN BE CHANGED TO 'C' WITHOUT LOSS OF INFORMATION.
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  SODDRV
C***END PROLOGUE  SODR
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,JOB,LDWD,LDX,LIWORK,LWORK,M,N,NDIGIT,NP
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),WD(LDWD,M),WORK(LWORK),X(LDX,M),Y(N)
      INTEGER
     +   IWORK(LIWORK)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      REAL
     +   NEGONE,PARTOL,SSTOL,TAUFAC
      INTEGER
     +   IPRINT,LDIFX,LDSCLD,LUNERR,LUNRPT,MAXIT
      LOGICAL
     +   SHORT
*
C...LOCAL ARRAYS
      REAL
     +   SCLB(1),SCLD(1,1),W(1)
      INTEGER
     +   IFIXB(1),IFIXX(1,1)
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SODDRV
*
C...DATA STATEMENTS
      DATA
     +   NEGONE
     +   /-1.0E0/
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXB(1)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(1,1)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL NEGONE
C        THE VALUE -1.0E0.
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLB(1)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(1,1)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL W(1)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WORK(LWORK)
C        THE REAL WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  SODR
*
*
C  INITIALIZE NECESSARY VARIABLES TO INDICATE USE OF DEFAULT VALUES
*
      IFIXX(1,1) = -1
      LDIFX = 1
      SCLD(1,1) = NEGONE
      LDSCLD = 1
      IFIXB(1) = -1
      SCLB(1) = NEGONE
      W(1) = NEGONE
      TAUFAC = NEGONE
      SSTOL = NEGONE
      PARTOL = NEGONE
      MAXIT = -1
      NDIGIT = -1
*
      SHORT = .TRUE.
*
      CALL SODDRV
     +     (SHORT,
     +     FUN,JAC,
     +     N,M,NP,
     +     X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +     Y,
     +     BETA,IFIXB,SCLB,
     +     WD,LDWD,W,
     +     JOB,NDIGIT,TAUFAC,
     +     SSTOL,PARTOL,MAXIT,
     +     IPRINT,LUNERR,LUNRPT,
     +     WORK,LWORK,IWORK,LIWORK,
     +     INFO)
*
      RETURN
*
      END
*SODRC
      SUBROUTINE SODRC
     +   (FUN,JAC,
     +   N,M,NP,
     +   X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +   Y,
     +   BETA,IFIXB,SCLB,
     +   WD,LDWD,W,
     +   JOB,NDIGIT,TAUFAC,
     +   SSTOL,PARTOL,MAXIT,
     +   IPRINT,LUNERR,LUNRPT,
     +   WORK,LWORK,IWORK,LIWORK,
     +   INFO)
C***BEGIN PROLOGUE  SODRC
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  USER-CALLABLE SINGLE PRECISION CONTROL ROUTINE FOR FINDING
C            THE WEIGHTED ORTHOGONAL DISTANCE REGRESSION (ODR) OR
C            ORDINARY LINEAR OR NONLINEAR LEAST SQUARES (OLS) SOLUTION
C            (LONG CALL STATEMENT)
C***DESCRIPTION
C      REFERENCE FOR ONLINE DOCUMENTATION IS GIVEN BELOW.
C      THE ONLINE DOCUMENTATION CAN BE INSERTED HERE IF REQUIRED BY
C      YOUR DOCUMENTATION RETRIEVAL SYSTEM.  ONLINE DOCUMENTATION DOES
C      NOT EXTEND BEYOND COLUMN 80, AND COLUMN 1 OF ONLINE
C      DOCUMENTATION CAN BE CHANGED TO 'C' WITHOUT LOSS OF INFORMATION.
C***REFERENCES  BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1987),
C                 "ODRPACK -- SOFTWARE FOR WEIGHTED ORTHOGONAL
C                 DISTANCE REGRESSION,"
C                 UNIVERSITY OF COLORADO DEPARTMENT OF COMPUTER SCIENCE
C                 TECHNICAL REPORT NUMBER CU-CS-360-87.
C                 (TO APPEAR IN ACM TRANS. MATH. SOFTWARE.)
C               BOGGS, P. T., R. H. BYRD, J. R. DONALDSON, AND
C                 R. B. SCHNABEL (1989),
C                 "REFERENCE GUIDE FOR ODRPACK SOFTWARE FOR WEIGHTED
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 ONLINE DOCUMENTATION AVAILABLE FROM AUTHORS
C               BOGGS, P. T., R. H. BYRD, AND R. B. SCHNABEL (1987),
C                 "A STABLE AND EFFICIENT ALGORITHM FOR NONLINEAR
C                 ORTHOGONAL DISTANCE REGRESSION,"
C                 SIAM J. SCI. STAT. COMPUT., 8(6):1052-1078.
C***ROUTINES CALLED  SODDRV
C***END PROLOGUE  SODRC
*
C...SCALAR ARGUMENTS
      REAL
     +   PARTOL,SSTOL,TAUFAC
      INTEGER
     +   INFO,IPRINT,JOB,LDIFX,LDSCLD,LDWD,LDX,LIWORK,LUNERR,
     +   LUNRPT,LWORK,M,MAXIT,N,NDIGIT,NP
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),SCLB(NP),SCLD(LDSCLD,M),
     +   W(N),WD(LDWD,M),WORK(LWORK),X(LDX,M),Y(N)
      INTEGER
     +   IFIXB(NP),IFIXX(LDIFX,M),IWORK(LIWORK)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN,JAC
*
C...LOCAL SCALARS
      LOGICAL
     +   SHORT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SODDRV
*
C...ROUTINE NAMES USED AS SUBPROGRAM ARGUMENTS
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE FUNCTION.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     EXTERNAL JAC
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE JACOBIANS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT JAC.)
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXB(NP)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF BETA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IFIXX(LDIFX,M)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF DELTA ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER INFO
C        AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE
C        COMPUTATIONS WERE STOPPED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IPRINT
C        THE PRINT CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER IWORK(LIWORK)
C        THE INTEGER WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER JOB
C        THE PROBLEM INITIALIZATION AND COMPUTATIONAL
C        METHOD CONTROL VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDIFX
C        THE LEADING DIMENSION OF ARRAY IFIXX.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDSCLD
C        THE LEADING DIMENSION OF ARRAY SCLD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LIWORK
C        THE LENGTH OF VECTOR IWORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNERR
C        THE LOGICAL UNIT NUMBER USED FOR ERROR MESSAGES.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LUNRPT
C        THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LWORK
C        THE LENGTH OF VECTOR WORK.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER MAXIT
C        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NDIGIT
C        THE NUMBER OF ACCURATE DIGITS IN THE FUNCTION RESULTS, AS
C        SUPPLIED BY THE USER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL PARTOL
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLB(NP)
C        THE SCALE OF EACH BETA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SCLD(LDSCLD,M)
C        THE SCALE OF EACH DELTA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL SHORT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE USER HAS
C        INVOKED ODRPACK BY THE SHORT-CALL (SHORT=.TRUE.) OR THE LONG-
C        CALL (SHORT=.FALSE.).
C     REAL SSTOL
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TAUFAC
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WORK(LWORK)
C        THE REAL WORK SPACE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL Y(N)
C        THE DEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  SODRC
*
*
      SHORT = .FALSE.
*
      CALL SODDRV
     +     (SHORT,
     +     FUN,JAC,
     +     N,M,NP,
     +     X,LDX,IFIXX,LDIFX,SCLD,LDSCLD,
     +     Y,
     +     BETA,IFIXB,SCLB,
     +     WD,LDWD,W,
     +     JOB,NDIGIT,TAUFAC,
     +     SSTOL,PARTOL,MAXIT,
     +     IPRINT,LUNERR,LUNRPT,
     +     WORK,LWORK,IWORK,LIWORK,
     +     INFO)
*
      RETURN
*
      END
*SODSTP
      SUBROUTINE SODSTP
     +   (N,NP,NPP,M,F,FJACB,LDFJB,FJACX,LDFJX,
     +   W,WD,LDWD,SS,TT,LDTT,DDELT,
     +   ALPHA,EPSMAC,
     +   SSS,TFJACB,VDTD,OMEGA,YT,U,QRAUX,WRK2,JPVT,
     +   S,T,PHI,IRANK,
     +   RCOND)
C***BEGIN PROLOGUE  SODSTP
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  ISAMAX,SCHEX,SDIAGS,SDOT,SIDTS,SNRM2,SQRDC,
C                    SQRSL,SROT,SROTG,STRCO,STRSL,SZERO
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE LOCALLY CONSTRAINED STEPS S AND T, AND PHI(ALPHA)
C***END PROLOGUE  SODSTP
*
C...SCALAR ARGUMENTS
      REAL
     +   ALPHA,EPSMAC,PHI,RCOND
      INTEGER
     +   IRANK,LDFJB,LDFJX,LDTT,LDWD,M,N,NP,NPP
*
C...ARRAY ARGUMENTS
      REAL
     +   DDELT(N,M),F(N),FJACB(LDFJB,NP),FJACX(LDFJX,M),
     +   OMEGA(N),QRAUX(NP),S(NP),SS(NP),
     +   SSS(N+N*M),T(N,M),TFJACB(N,NP),TT(LDTT,M),U(N),
     +   VDTD(N,M),W(N),WD(LDWD,M),WRK2(NP),YT(N)
      INTEGER
     +   JPVT(NP)
*
C...LOCAL SCALARS
      REAL
     +   CO,ONE,SI,TEMP,ZERO
      INTEGER
     +   I,IMAX,INF,IPVT,J,KP
      LOGICAL
     +   ELIM
*
C...LOCAL ARRAYS
      REAL
     +   DUM(1)
*
C...EXTERNAL FUNCTIONS
      REAL
     +   SDOT,SNRM2
      INTEGER
     +   ISAMAX
      EXTERNAL
     +   SDOT,SNRM2,ISAMAX
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SCHEX,SDIAGS,SIDTS,SQRDC,SQRSL,SROT,SROTG,STRCO,STRSL,
     +   SZERO
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE
     +   /0.0E0,1.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL ALPHA
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     REAL CO
C        THE COSINE FROM THE PLANE ROTATION.
C     REAL DDELT(N,M)
C        THE ARRAY (W*D)**2 * DELTA.
C     REAL DUM
C        AN DUMMY VARIABLE.
C     LOGICAL ELIM
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER COLUMNS OF THE
C        JACOBIAN WRT BETA HAVE BEEN ELIMINATED (ELIM=.TRUE.) OR NOT
C        (ELIM=.FALSE.).
C     REAL EPSMAC
C        THE VALUE OF MACHINE PRECISION.
C     REAL F(N)
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     REAL FJACB(LDFJB,NP)
C        THE JACOBIAN WITH RESPECT TO BETA.
C     REAL FJACX(LDFJX,M)
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IMAX
C        THE INDEX OF THE ELEMENT OF U HAVING THE LARGEST ABSOLUTE
C        VALUE.
C     INTEGER INF
C        THE RETURN CODE FROM SQRSL AND STRSL.
C     INTEGER IPVT
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER OR NOT
C        PIVOTING IS TO BE DONE.
C     INTEGER IRANK
C        THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER JPVT(NP)
C        THE PIVOT VECTOR.
C     INTEGER KP
C        THE RANK OF THE JACOBIAN WRT BETA.
C     INTEGER LDFJB
C        THE LEADING DIMENSION OF ARRAY FJACB.
C     INTEGER LDFJX
C        THE LEADING DIMENSION OF ARRAY FJACX.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NPP
C        THE NUMBER OF FUNCTION PARAMETERS ACTUALLY BEING ESTIMATED.
C     REAL OMEGA(N)
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL PHI
C        THE DIFFERENCE BETWEEN THE NORM OF THE SCALED STEP
C        AND THE TRUST REGION DIAMETER.
C     REAL QRAUX(NP)
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     REAL RCOND
C        THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB.
C     REAL S(NP)
C        THE STEP FOR THE ESTIMATED BETA'S.
C     REAL SI
C        THE SINE FROM THE PLANE ROTATION.
C     REAL SS(NP)
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL SSS(N+N*M)
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     REAL T(N,M)
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     REAL TEMP
C        A TEMPORARY STORAGE LOCATION.
C     REAL TFJACB(N,NP)
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL U(N)
C        THE APPROXIMATE NULL VECTOR FOR TFJACB.
C     REAL VDTD(N,M)
C        THE ARRAY DDELT*INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WRK2(NP)
C        A WRK2 ARRAY.
C     REAL YT(N)
C         THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SODSTP
*
*
C  COMPUTE LOOP PARAMETERS WHICH DEPEND ON WEIGHT STRUCTURE
*
C  SET UP JPVT IF ALPHA = 0
*
      IF (ALPHA.EQ.ZERO) THEN
         KP = NPP
         DO 10 I=1,NPP
            JPVT(I) = I
   10    CONTINUE
      ELSE
         IF (NPP.GE.1) THEN
            KP = NPP-IRANK
         ELSE
            KP = NPP
         END IF
      END IF
*
C  SET UP OMEGA AND TFJACB
C  (VDTD = FJACX * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2)
*
      CALL SIDTS(N,M,W,WD,LDWD,ALPHA,TT,LDTT,FJACX,LDFJX,VDTD,N)
      DO 20 I=1,N
         OMEGA(I) = SQRT(ONE+SDOT(M,VDTD(I,1),N,FJACX(I,1),LDFJX))
   20 CONTINUE
      DO 40 J=1,KP
         DO 30 I=1,N
            TFJACB(I,J) = FJACB(I,JPVT(J))/OMEGA(I)
   30    CONTINUE
   40 CONTINUE
*
C  SET UP VDTD AND YT
C  (VDTD = DDELT * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2)
*
      CALL SIDTS(N,M,W,WD,LDWD,ALPHA,TT,LDTT,DDELT,N,VDTD,N)
      DO 50 I=1,N
         VDTD(I,1) = SDOT(M,FJACX(I,1),LDFJX,VDTD(I,1),N)
         YT(I) = -(F(I)-VDTD(I,1))/OMEGA(I)
   50 CONTINUE
*
C  COMPUTE S
*
C  DO QR FACTORIZATION (WITH COLUMN PIVOTING OF TRJACB IF ALPHA = 0)
*
      IF (ALPHA.EQ.ZERO) THEN
         IPVT = 1
         DO 60 I=1,NPP
            JPVT(I) = 0
   60    CONTINUE
      ELSE
         IPVT = 0
      END IF
*
      CALL SQRDC(TFJACB,N,N,KP,QRAUX,JPVT,WRK2,IPVT)
*
C     GET TR(Q)*YT
*
      CALL SQRSL(TFJACB,N,N,KP,QRAUX,YT,DUM,YT,DUM,DUM,DUM,1000,INF)
*
C  ELIMINATE ALPHA PART USING GIVENS ROTATIONS
*
      IF (ALPHA.NE.ZERO) THEN
         CALL SZERO(NPP,1,S,NPP)
         DO 90 I=1,KP
            CALL SZERO(KP,1,WRK2,KP)
            IF (SS(1).GT.ZERO) THEN
               WRK2(I) = SQRT(ALPHA)*SS(JPVT(I))
            ELSE
               WRK2(I) = SQRT(ALPHA)*ABS(SS(1))
            END IF
            DO 80 J=I,KP
               CALL SROTG(TFJACB(J,J),WRK2(J),CO,SI)
               IF (KP-J.GE.1) THEN
                  CALL SROT(KP-J,TFJACB(J,J+1),N,WRK2(J+1),1,CO,SI)
               END IF
               TEMP = CO*YT(J) + SI*S(JPVT(I))
               S(JPVT(I)) = -SI*YT(J) + CO*S(JPVT(I))
               YT(J) = TEMP
   80       CONTINUE
   90    CONTINUE
      END IF
*
C  COMPUTE SOLUTION - ELIMINATE VARIABLES IF NECESSARY
*
      IF (NPP.GE.1) THEN
         IF (ALPHA.EQ.ZERO) THEN
            KP = NPP
*
C  ESTIMATE RCOND - U WILL CONTAIN APPROX NULL VECTOR
*
  100       CALL STRCO(TFJACB,N,KP,RCOND,U,1)
            IF (RCOND.LE.EPSMAC) THEN
               ELIM = .TRUE.
               IMAX = ISAMAX(KP,U,1)
*
C IMAX IS THE COLUMN TO REMOVE - USE SCHEX AND FIX JPVT
*
               IF (IMAX.NE.KP) THEN
                  CALL SCHEX(TFJACB,N,KP,IMAX,KP,YT,N,1,QRAUX,WRK2,2)
                  J = JPVT(IMAX)
                  DO 110 I=IMAX,KP-1
                     JPVT(I) = JPVT(I+1)
  110             CONTINUE
                  JPVT(KP) = J
               END IF
               KP = KP-1
            ELSE
               ELIM = .FALSE.
            END IF
            IF (ELIM .AND. KP.GE.1) THEN
               GO TO 100
            ELSE
               IRANK = NPP-KP
            END IF
         END IF
*
C  BACKSOLVE AND UNSCRAMBLE
*
         DO 120 I=KP+1,NPP
            YT(I) = ZERO
  120    CONTINUE
         IF (KP.GE.1) THEN
            CALL STRSL(TFJACB,N,KP,YT,01,INF)
         END IF
         DO 130 I=1,NPP
            S(JPVT(I)) = YT(I)
  130    CONTINUE
      END IF
*
C  COMPUTE T
*
      DO 140 I=1,N
         TEMP = F(I)+SDOT(NPP,FJACB(I,1),LDFJB,S,1)
         U(I) = (TEMP-VDTD(I,1))/(OMEGA(I)**2)
  140 CONTINUE
      DO 160 J=1,M
         DO 150 I=1,N
            T(I,J) = -(FJACX(I,J)*U(I) + DDELT(I,J))
  150    CONTINUE
  160 CONTINUE
*
C  (T = T * INV(DT) WHERE DT = (W*D)**2 + ALPHA*TT**2)
*
      CALL SIDTS(N,M,W,WD,LDWD,ALPHA,TT,LDTT,T,N,T,N)
*
C  COMPUTE PHI(ALPHA) FROM SCALED S AND T
*
      IF (NPP.GE.1) THEN
         CALL SDIAGS(NPP,1,SS,NPP,S,NPP,SSS,NPP)
      END IF
      CALL SDIAGS(N,M,TT,LDTT,T,N,SSS(NPP+1),N)
      PHI = SNRM2(NPP+N*M,SSS,1)
*
      RETURN
      END
*SPACK
      SUBROUTINE SPACK
     +   (N2,N1,V1,V2,IFIX)
C***BEGIN PROLOGUE  SPACK
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SCOPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SELECT THE UNFIXED ELEMENTS OF V2 AND RETURN THEM IN V1
C***END PROLOGUE  SPACK
*
C...SCALAR ARGUMENTS
      INTEGER
     +   N1,N2
*
C...ARRAY ARGUMENTS
      REAL
     +   V1(N2),V2(N2)
      INTEGER
     +   IFIX(N2)
*
C...LOCAL SCALARS
      INTEGER
     +   I
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SCOPY
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIX(N2)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF V2 ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE DISCUSSION OF IFIXB AND IFIXX IN PROLOGUE OF
C        SUBROUTINE SODR OR SODRC.)
C     INTEGER N1
C        THE NUMBER OF ITEMS IN V1.
C     INTEGER N2
C        THE NUMBER OF ITEMS IN V2.
C     REAL V1(N2)
C        THE VECTOR OF THE UNFIXED ITEMS FROM V2.
C     REAL V2(N2)
C        THE VECTOR OF THE FIXED AND UNFIXED ITEMS FROM WHICH THE
C        UNFIXED ELEMENTS ARE TO BE EXTRACTED.
*
*
C***FIRST EXECUTABLE STATEMENT  SPACK
*
*
      N1 = 0
      IF (IFIX(1).GE.0) THEN
         DO 10 I=1,N2
            IF (IFIX(I).NE.0) THEN
               N1 = N1+1
               V1(N1) = V2(I)
            END IF
   10    CONTINUE
      ELSE
         N1 = N2
         CALL SCOPY(N2,V2,1,V1,1)
      END IF
*
      RETURN
      END
*SPVB
      REAL FUNCTION SPVB
     +   (FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,NROW,J,STP,ISTOPF)
C***BEGIN PROLOGUE  SPVB
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE THE NROW-TH FUNCTION VALUE USING BETA(J) + STP
C***END PROLOGUE  SPVB
*
C...SCALAR ARGUMENTS
      REAL
     +   STP
      INTEGER
     +   ISTOPF,J,LDXPD,M,N,NFEV,NP,NROW
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   TEMP
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUE FROM THE MODEL.
C     REAL STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE.
C     REAL TEMP
C        A TEMPORARY LOCATION IN WHICH THE CURRENT ESTIMATE OF THE JTH
C        PARAMETER IS STORED.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  SPVB
*
*
C  COMPUTE PREDICTED VALUES
*
      TEMP = BETA(J)
      BETA(J) = BETA(J) + STP
      ISTOPF = 0
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,ISTOPF)
      NFEV = NFEV + 1
      BETA(J) = TEMP
*
      SPVB = PVTEMP(NROW)
*
      RETURN
      END
*SPVD
      REAL FUNCTION SPVD
     +   (FUN,NFEV,N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,NROW,J,STP,ISTOPF)
C***BEGIN PROLOGUE  SPVD
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE NROW-TH FUNCTION VALUE USING
C            X(NROW,J) + DELTA(NROW,J) + STP
C***END PROLOGUE  SPVD
*
C...SCALAR ARGUMENTS
      REAL
     +   STP
      INTEGER
     +   ISTOPF,J,LDXPD,M,N,NFEV,NP,NROW
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),PVTEMP(N),XPLUSD(LDXPD,M)
*
C...SUBROUTINE ARGUMENTS
      EXTERNAL
     +   FUN
*
C...LOCAL SCALARS
      REAL
     +   TEMP
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     EXTERNAL FUN
C        THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B,
C        ARGUMENT FUN.)
C     INTEGER ISTOPF
C        AN INDICATOR VARIABLE, BY WHICH THE USER CAN SPECIFY THAT THERE
C        ARE PROBLEMS COMPUTING THE FUNCTION GIVEN THE CURRENT ESTIMATES
C        OF BETA AND DELTA.
C     INTEGER J
C        THE INDEX OF THE PARTIAL DERIVATIVE BEING EXAMINED.
C     INTEGER LDXPD
C        THE LEADING DIMENSION OF ARRAY XPLUSD.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NFEV
C        THE NUMBER OF FUNCTION EVALUATIONS.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE NUMBER OF THE ROW OF THE INDEPENDENT VARIABLE ARRAY AT
C        WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL PVTEMP(N)
C        THE VECTOR OF PREDICTED VALUE FROM THE MODEL.
C     REAL STP
C        THE STEP SIZE CURRENTLY BEING EXAMINED FOR THE FINITE DIFFERENC
C        DERIVATIVE.
C     REAL TEMP
C        A TEMPORARY LOCATION IN WHICH THE CURRENT ESTIMATE OF THE
C        (NROW,J)TH ELEMENT OF XPLUSD IS STORED.
C     REAL XPLUSD(LDXPD,M)
C        THE ARRAY X + DELTA.
*
*
C***FIRST EXECUTABLE STATEMENT  SPVD
*
*
C  COMPUTE PREDICTED VALUES
*
      TEMP = XPLUSD(NROW,J)
      XPLUSD(NROW,J) = XPLUSD(NROW,J) + STP
      ISTOPF = 0
      CALL FUN(N,NP,M,BETA,XPLUSD,LDXPD,PVTEMP,ISTOPF)
      NFEV = NFEV + 1
      XPLUSD(NROW,J) = TEMP
*
      SPVD = PVTEMP(NROW)
*
      RETURN
      END
*SSCLB
      SUBROUTINE SSCLB
     +   (NP,BETA,SSF)
C***BEGIN PROLOGUE  SSCLB
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE APPROPRIATE SCALE VALUES FOR BETA'S ACCORDING TO
C            THE ALGORITHM GIVEN IN THE PROLOGUES FOR SODR AND SODRC
C***END PROLOGUE  SSCLB
*
C...SCALAR ARGUMENTS
      INTEGER
     +   NP
*
C...ARRAY ARGUMENTS
      REAL
     +   BETA(NP),SSF(NP)
*
C...LOCAL SCALARS
      REAL
     +   BMAX,BMIN,ONE,TEN,ZERO
      INTEGER
     +   K
      LOGICAL
     +   BIGDIF
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,LOG10,MAX,MIN,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TEN
     +   /0.0E0,1.0E0,10.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL BETA(NP)
C        THE FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     LOGICAL BIGDIF
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THERE IS A
C        SIGNIFICANT DIFFERENCE IN THE MAGNITUDES OF THE NONZERO
C        BETA'S (BIGDIF=.TRUE.) OR NOT (BIGDIF=.FALSE.).
C     REAL BMAX
C        THE LARGEST NONZERO MAGNITUDE.
C     REAL BMIN
C        THE SMALLEST NONZERO MAGNITUDE.
C     INTEGER K
C        AN INDEXING VARIABLE.
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL SSF(NP)
C        THE SCALE USED FOR THE BETA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL TEN
C        THE VALUE 10.0E0.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SSCLB
*
*
      BMAX = ABS(BETA(1))
      DO 10 K=2,NP
         BMAX = MAX(BMAX,ABS(BETA(K)))
   10 CONTINUE
*
      IF (BMAX.EQ.ZERO) THEN
*
C  ALL INPUT VALUES OF BETA ARE ZERO
*
         DO 20 K=1,NP
            SSF(K) = ONE
   20    CONTINUE
*
      ELSE
*
C  SOME OF THE INPUT VALUES ARE NONZERO
*
         BMIN = BMAX
         DO 30 K=1,NP
            IF (BETA(K).NE.ZERO) THEN
               BMIN = MIN(BMIN,ABS(BETA(K)))
            END IF
   30    CONTINUE
         BIGDIF = LOG10(BMAX)-LOG10(BMIN).GE.ONE
         DO 40 K=1,NP
            IF (BETA(K).EQ.ZERO) THEN
               SSF(K) =  TEN/BMIN
            ELSE
               IF (BIGDIF) THEN
                  SSF(K) = ONE/ABS(BETA(K))
               ELSE
                  SSF(K) = ONE/BMAX
               END IF
            END IF
   40    CONTINUE
*
      END IF
*
      RETURN
      END
*SSCLD
      SUBROUTINE SSCLD
     +   (N,M,X,LDX,TT,LDTT)
C***BEGIN PROLOGUE  SSCLD
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE APPROPRIATE SCALE VALUES FOR DELTA'S ACCORDING TO
C            THE ALGORITHM GIVEN IN THE PROLOGUES FOR SODR AND SODRC
C***END PROLOGUE  SSCLD
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDTT,LDX,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   TT(LDTT,M),X(LDX,M)
*
C...LOCAL SCALARS
      REAL
     +   ONE,TEN,XMAX,XMIN,ZERO
      INTEGER
     +   I,J
      LOGICAL
     +   BIGDIF
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,LOG10,MAX,MIN
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE,TEN
     +   /0.0E0,1.0E0,10.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     LOGICAL BIGDIF
C        THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THERE IS A
C        SIGNIFICANT DIFFERENCE IN THE MAGNITUDES OF THE NONZERO
C        BETA'S (BIGDIF=.TRUE.) OR NOT (BIGDIF=.FALSE.).
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDTT
C        THE LEADING DIMENSION OF ARRAY TT.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL ONE
C        THE VALUE 1.0E0.
C     REAL TT(LDTT,M)
C        THE SCALE USED FOR THE DELTA'S.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL XMAX
C        THE LARGEST NONZERO MAGNITUDE.
C     REAL XMIN
C        THE SMALLEST NONZERO MAGNITUDE.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SSCLD
*
*
      DO 50 J=1,M
         XMAX = ABS(X(1,J))
         DO 10 I=2,N
            XMAX = MAX(XMAX,ABS(X(I,J)))
   10    CONTINUE
*
         IF (XMAX.EQ.ZERO) THEN
*
C  ALL INPUT VALUES OF X(I,J), I=1,...,N, ARE ZERO
*
            DO 20 I=1,N
               TT(I,J) = ONE
   20       CONTINUE
*
         ELSE
*
C  SOME OF THE INPUT VALUES ARE NONZERO
*
            XMIN = XMAX
            DO 30 I=1,N
               IF (X(I,J).NE.ZERO) THEN
                  XMIN = MIN(XMIN,ABS(X(I,J)))
               END IF
   30       CONTINUE
            BIGDIF = LOG10(XMAX)-LOG10(XMIN).GE.ONE
            DO 40 I=1,N
               IF (X(I,J).NE.ZERO) THEN
                  IF (BIGDIF) THEN
                     TT(I,J) = ONE/ABS(X(I,J))
                  ELSE
                     TT(I,J) = ONE/XMAX
                  END IF
               ELSE
                  TT(I,J) = TEN/XMIN
               END IF
   40       CONTINUE
         END IF
   50 CONTINUE
*
      RETURN
      END
*SSETN
      SUBROUTINE SSETN
     +   (N,M,X,LDX,NROW)
C***BEGIN PROLOGUE  SSETN
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SELECT THE ROW AT WHICH THE DERIVATIVE WILL BE CHECKED
C***END PROLOGUE  SSETN
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDX,M,N,NROW
*
C...ARRAY ARGUMENTS
      REAL
     +   X(LDX,M)
*
C...LOCAL SCALARS
      INTEGER
     +   I,J
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEX VARIABLE.
C     INTEGER J
C        AN INDEX VARIABLE.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NROW
C        THE USER-SUPPLIED NUMBER OF THE ROW OF THE INDEPENDENT
C        VARIABLE ARRAY AT WHICH THE DERIVATIVE IS TO BE CHECKED.
C     REAL X(LDX,M)
C        THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
*
*
C***FIRST EXECUTABLE STATEMENT  SSETN
*
*
      IF ((NROW.GE.1) .AND. (NROW.LE.N)) RETURN
*
C     SELECT FIRST ROW OF INDEPENDENT VARIABLES WHICH CONTAINS NO ZEROS
C     IF THERE IS ONE, OTHERWISE FIRST ROW IS USED.
*
      DO 20 I = 1, N
         DO 10 J = 1, M
            IF (X(I,J).EQ.0.0) GO TO 20
   10    CONTINUE
         NROW = I
         RETURN
   20 CONTINUE
*
      NROW = 1
*
      RETURN
      END
*SUNPAC
      SUBROUTINE SUNPAC
     +   (N2,V1,V2,IFIX)
C***BEGIN PROLOGUE  SUNPAC
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  SCOPY
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COPY THE ELEMENTS OF V1 INTO THE LOCATIONS OF V2 WHICH ARE
C            UNFIXED
C***END PROLOGUE  SUNPAC
*
C...SCALAR ARGUMENTS
      INTEGER
     +   N2
*
C...ARRAY ARGUMENTS
      REAL
     +   V1(N2),V2(N2)
      INTEGER
     +   IFIX(N2)
*
C...LOCAL SCALARS
      INTEGER
     +   I,N1
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SCOPY
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER IFIX(N2)
C        THE INDICATOR VALUES USED TO DESIGNATE WHETHER THE INDIVIDUAL
C        ELEMENTS OF V2 ARE FIXED AT THEIR INPUT VALUES OR NOT.
C        (FOR DETAILS, SEE DISCUSSION OF IFIXB AND IFIXX IN PROLOGUE OF
C        SUBROUTINE SODR OR SODRC.)
C     INTEGER N1
C        THE NUMBER OF ITEMS IN V1.
C     INTEGER N2
C        THE NUMBER OF ITEMS IN V2.
C     REAL V1(N2)
C        THE VECTOR OF THE UNFIXED ITEMS.
C     REAL V2(N2)
C        THE VECTOR OF THE FIXED AND UNFIXED ITEMS INTO WHICH THE
C        ELEMENTS OF V1 ARE TO BE INSERTED.
*
*
C***FIRST EXECUTABLE STATEMENT  SUNPAC
*
*
      N1 = 0
      IF (IFIX(1).GE.0) THEN
         DO 10 I = 1,N2
            IF (IFIX(I).NE.0) THEN
               N1 = N1 + 1
               V2(I) = V1(N1)
            END IF
   10    CONTINUE
      ELSE
         N1 = N2
         CALL SCOPY(N2,V1,1,V2,1)
      END IF
*
      RETURN
      END
*SWDS
      SUBROUTINE SWDS
     +   (N,M,W,WD,LDWD,T,LDT,WDT,LDWDT)
C***BEGIN PROLOGUE  SWDS
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SCALE MATRIX T USING W*D, I.E., COMPUTE
C            WDT = W*D*T
C            WHERE W AND D ARE DEFINED BY EQ.2 OF THE PROLOGUES FOR
C            SODR AND SODRC
C***END PROLOGUE  SWDS
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDT,LDWD,LDWDT,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   T(LDT,M),W(N),WD(LDWD,M),WDT(LDWDT,M)
*
C...LOCAL SCALARS
      REAL
     +   TEMP,ZERO
      INTEGER
     +   I,J
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDT
C        THE LEADING DIMENSION OF ARRAY T.
C     INTEGER LDWD
C        THE LEADING DIMENSION OF ARRAY WD.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER LDWDT
C        THE LEADING DIMENSION OF ARRAY WDT.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL T(LDT,M)
C        THE ARRAY BEING SCALED BY W*D.
C     REAL TEMP
C        A TEMPORARY STORAGE LOCATION.
C     REAL W(N)
C        THE OBSERVATIONAL ERROR WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WD(LDWD,M)
C        THE DELTA WEIGHTS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     REAL WDT(LDWDT,M)
C        THE RESULTS OF SCALING ARRAY T BY W*D.
C     REAL ZERO
C          THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SWDS
*
*
      IF (N.EQ.0 .OR. M.EQ.0) RETURN
*
      IF (W(1).GE.ZERO) THEN
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               DO 20 J=1,M
                  DO 10 I=1,N
                     WDT(I,J) = W(I)*WD(I,J)*T(I,J)
   10             CONTINUE
   20          CONTINUE
            ELSE
               DO 40 J=1,M
                  DO 30 I=1,N
                     WDT(I,J) = W(I)*WD(1,J)*T(I,J)
   30             CONTINUE
   40          CONTINUE
            END IF
         ELSE
            DO 60 J=1,M
               DO 50 I=1,N
                  WDT(I,J) = W(I)*ABS(WD(1,1))*T(I,J)
   50          CONTINUE
   60       CONTINUE
         END IF
      ELSE
         IF (WD(1,1).GT.ZERO) THEN
            IF (LDWD.GE.N) THEN
               DO 80 J=1,M
                  DO 70 I=1,N
                     WDT(I,J) = WD(I,J)*T(I,J)
   70             CONTINUE
   80          CONTINUE
            ELSE
               DO 100 J=1,M
                  TEMP = WD(1,J)
                  DO 90 I=1,N
                     WDT(I,J) = TEMP*T(I,J)
   90             CONTINUE
  100          CONTINUE
            END IF
         ELSE
            TEMP = ABS(WD(1,1))
            DO 120 J=1,M
               DO 110 I=1,N
                  WDT(I,J) = TEMP*T(I,J)
  110          CONTINUE
  120       CONTINUE
         END IF
      END IF
*
      RETURN
      END
*SWINF
      SUBROUTINE SWINF
     +   (N,M,NP,
     +   DELTAI,EPSI,
     +   WSSI,WSSDEI,WSSEPI,RVARI,
     +   PARTLI,SSTOLI,TAUFCI,EPSMAI,OLMAVI,
     +   FJACBI,FJACXI,XPLUSI,BETACI,BETASI,BETANI,DELTSI,
     +   DELTNI,DDELTI,FSI,FNI,SI,SSSI,SSI,SSFI,TI,TTI,TAUI,
     +   ALPHAI,VCVI,OMEGAI,YTI,UI,QRAUXI,WRK1I,SEI,RCONDI,
     +   ETAI,ACTRSI,PNORMI,PRERSI,RNORSI,
     +   LWKMN)
C***BEGIN PROLOGUE  SWINF
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET STORAGE LOCATIONS WITHIN REAL WORK SPACE
C***END PROLOGUE  SWINF
*
C...SCALAR ARGUMENTS
      INTEGER
     +   ACTRSI,ALPHAI,BETACI,BETANI,BETASI,DDELTI,DELTAI,DELTNI,DELTSI,
     +   EPSI,EPSMAI,ETAI,FJACBI,FJACXI,FNI,FSI,LWKMN,M,N,NP,OLMAVI,
     +   OMEGAI,PARTLI,PNORMI,PRERSI,QRAUXI,RCONDI,RNORSI,RVARI,SEI,SI,
     +   SSFI,SSI,SSSI,SSTOLI,TAUFCI,TAUI,TI,TTI,UI,VCVI,WRK1I,
     +   WSSI,WSSDEI,WSSEPI,XPLUSI,YTI
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER ACTRSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED ACTUAL RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER ALPHAI
C        THE LOCATION IN ARRAY WORK OF
C        THE LEVENBERG-MARQUARDT PARAMETER.
C     INTEGER BETACI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE CURRENT ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETANI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER BETASI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED VALUES OF THE UNFIXED BETA'S.
C     INTEGER DDELTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (W*D)**2 * DELTA.
C     INTEGER DELTAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER DELTSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES.
C     INTEGER EPSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER EPSMAI
C        THE LOCATION IN ARRAY WORK OF
C        THE VALUE OF MACHINE PRECISION.
C     INTEGER ETAI
C        THE LOCATION IN ARRAY WORK OF
C        THE RELATIVE NOISE IN THE FUNCTION RESULTS.
C     INTEGER FJACBI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO BETA.
C     INTEGER FJACXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE JACOBIAN WITH RESPECT TO X.
C     INTEGER FNI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE NEW (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER FSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SAVED (WEIGHTED) ESTIMATED VALUES OF EPSILON.
C     INTEGER LWKMN
C        THE MINIMUM ACCEPTABLE LENGTH OF ARRAY WORK.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER N
C        THE NUMBER OF OBSERVATIONS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER NP
C        THE NUMBER OF FUNCTION PARAMETERS.
C        (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.)
C     INTEGER OLMAVI
C        THE LOCATION IN ARRAY WORK OF
C        THE AVERAGE NUMBER OF LEVENBERG-MARQUARDT STEPS PER ITERATION.
C     INTEGER OMEGAI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY (I-FJACX*INV(P)*TRANS(FJACX))**(-1/2)  WHERE
C        P = TRANS(FJACX)*FJACX + D**2 + ALPHA*TT**2
C     INTEGER PARTLI
C        THE LOCATION IN ARRAY WORK OF
C        THE PARAMETER CONVERGENCE STOPPING CRITERIA.
C     INTEGER PNORMI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SCALED ESTIMATED PARAMETERS.
C     INTEGER PRERSI
C        THE LOCATION IN ARRAY WORK OF
C        THE SAVED PREDICTED RELATIVE REDUCTION IN THE SUM-OF-SQUARES
C        OF THE WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER QRAUXI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY REQUIRED TO RECOVER THE ORTHOGONAL PART OF THE
C        Q-R DECOMPOSITION.
C     INTEGER RCONDI
C        THE LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE RECIPROCAL CONDITION OF
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER RNORSI
C        THE LOCATION IN ARRAY WORK OF
C        THE NORM OF THE SAVED WEIGHTED OBSERVATIONAL ERRORS.
C     INTEGER RVARI
C        THE LOCATION IN ARRAY WORK OF
C        THE RESIDUAL VARIANCE.
C     INTEGER SEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STANDARD ERRORS FOR THE PARAMETERS, ALSO USED AS A
C        WORK ARRAY.
C     INTEGER SI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED BETA'S.
C     INTEGER SSFI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE BETA'S.
C     INTEGER SSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE ESTIMATED BETA'S.
C     INTEGER SSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY USED TO COMPUTED VARIOUS SUMS-OF-SQUARES.
C     INTEGER SSTOLI
C        THE LOCATION IN ARRAY WORK OF
C        THE SUM-OF-SQUARES CONVERGENCE STOPPING CRITERIA.
C     INTEGER TAUFCI
C        THE LOCATION IN ARRAY WORK OF
C        THE FACTOR USED TO COMPUTE THE INITIAL TRUST REGION DIAMETER.
C     INTEGER TAUI
C        THE LOCATION IN ARRAY WORK OF
C        THE TRUST REGION DIAMETER.
C     INTEGER TI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE STEP FOR THE ESTIMATED DELTA'S.
C     INTEGER TTI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SCALE USED FOR THE DELTA'S.
C     INTEGER UI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE NULL VECTOR FOR
C        THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER VCVI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE APPROXIMATE VARIANCE COVARIANCE MATRIX, ALSO USED
C        TO STORE THE ARRAY INV(DIAG(SQRT(OMEGA(I)),I=1,...,N))*FJACB.
C     INTEGER WRK1I
C        THE STARTING LOCATION IN ARRAY WORK OF
C        A WORK ARRAY.
C     INTEGER WSSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS AND DELTAS.
C     INTEGER WSSDEI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED DELTAS.
C     INTEGER WSSEPI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE SUM OF THE SQUARES OF THE WEIGHTED EPSILONS.
C     INTEGER XPLUSI
C        THE STARTING LOCATION IN ARRAY WORK OF
C        THE ARRAY X + DELTA.
C     INTEGER YTI
C         THE STARTING LOCATION IN WORK OF
C         THE ARRAY -(DIAG(SQRT(OMEGA(I)),I=1,...,N)*(G1-V*INV(E)*D*G2).
*
*
C***FIRST EXECUTABLE STATEMENT  SWINF
*
*
      IF (N.GE.1 .AND. NP.GE.1 .AND. M.GE.1) THEN
         DELTAI =          1
         EPSI   = DELTAI + N*M
         WSSI   = EPSI   + N
         WSSDEI = WSSI   + 1
         WSSEPI = WSSDEI + 1
         RVARI  = WSSEPI + 1
         PARTLI = RVARI  + 1
         SSTOLI = PARTLI + 1
         TAUFCI = SSTOLI + 1
         EPSMAI = TAUFCI + 1
         OLMAVI = EPSMAI + 1
         FJACBI = OLMAVI + 1
         FJACXI = FJACBI + N*NP
         XPLUSI = FJACXI + N*M
         BETACI = XPLUSI + N*M
         BETASI = BETACI + NP
         BETANI = BETASI + NP
         DELTSI = BETANI + NP
         DELTNI = DELTSI + N*M
         DDELTI = DELTNI + N*M
         FSI    = DDELTI + N*M
         FNI    = FSI    + N
         SI     = FNI    + N
         SSSI   = SI     + NP
         SSI    = SSSI   + N*M + N
         SSFI   = SSI    + NP
         TI     = SSFI   + NP
         TTI    = TI     + N*M
         TAUI   = TTI    + N*M
         ALPHAI = TAUI   + 1
         VCVI   = ALPHAI + 1
         OMEGAI = VCVI   + N*NP
         YTI    = OMEGAI + N
         UI     = YTI    + N
         QRAUXI = UI     + N
         WRK1I  = QRAUXI + NP
         SEI    = WRK1I  + N*M
         RCONDI = SEI    + NP
         ETAI   = RCONDI + 1
         ACTRSI = ETAI   + 1
         PNORMI = ACTRSI + 1
         PRERSI = PNORMI + 1
         RNORSI = PRERSI + 1
         LWKMN  = RNORSI
      ELSE
         DELTAI = 1
         EPSI   = 1
         WSSI   = 1
         WSSDEI = 1
         WSSEPI = 1
         RVARI  = 1
         PARTLI = 1
         SSTOLI = 1
         TAUFCI = 1
         EPSMAI = 1
         OLMAVI = 1
         FJACBI = 1
         FJACXI = 1
         XPLUSI = 1
         BETACI = 1
         BETASI = 1
         BETANI = 1
         DELTSI = 1
         DELTNI = 1
         DDELTI = 1
         FSI    = 1
         FNI    = 1
         SI     = 1
         SSSI   = 1
         SSI    = 1
         SSFI   = 1
         TI     = 1
         TTI    = 1
         TAUI   = 1
         ALPHAI = 1
         VCVI   = 1
         OMEGAI = 1
         YTI    = 1
         UI     = 1
         QRAUXI = 1
         WRK1I  = 1
         SEI    = 1
         RCONDI = 1
         ETAI   = 1
         ACTRSI = 1
         PNORMI = 1
         PRERSI = 1
         RNORSI = 1
         LWKMN  = 1
      END IF
*
      RETURN
      END
*SXPY
      SUBROUTINE SXPY
     +   (N,M,X,LDX,Y,LDY,XPY,LDXPY)
C***BEGIN PROLOGUE  SXPY
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  COMPUTE XPY = X + Y
C***END PROLOGUE  SXPY
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDX,LDXPY,LDY,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   X(LDX,M),XPY(LDXPY,M),Y(LDY,M)
*
C...LOCAL SCALARS
      INTEGER
     +   I,J
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDX
C        THE LEADING DIMENSION OF ARRAY X.
C     INTEGER LDXPY
C        THE LEADING DIMENSION OF ARRAY XPY.
C     INTEGER LDY
C        THE LEADING DIMENSION OF ARRAY Y.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN ARRAYS X AND Y TO BE ADDED
C        TOGETHER.
C     INTEGER N
C        THE NUMBER OF ROWS OF DATA IN ARRAYS X AND Y TO BE ADDED
C        TOGETHER.
C     REAL X(LDX,M)
C        THE FIRST OF THE TWO ARRAYS TO BE ADDED TOGETHER.
C     REAL XPY(LDXPY,M)
C        THE SUM OF THE TWO ARRAYS TO BE ADDED TOGETHER.
C     REAL Y(LDY,M)
C        THE SECOND OF THE TWO ARRAYS TO BE ADDED TOGETHER.
*
*
C***FIRST EXECUTABLE STATEMENT  SXPY
*
*
      DO 20 J=1,M
         DO 10 I=1,N
            XPY(I,J) = X(I,J) + Y(I,J)
   10    CONTINUE
   20 CONTINUE
*
      RETURN
      END
*SZERO
      SUBROUTINE SZERO
     +   (N,M,A,LDA)
C***BEGIN PROLOGUE  SZERO
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO, BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  SET A = ZERO
C***END PROLOGUE  SZERO
*
C...SCALAR ARGUMENTS
      INTEGER
     +   LDA,M,N
*
C...ARRAY ARGUMENTS
      REAL
     +   A(LDA,M)
*
C...LOCAL SCALARS
      REAL
     +   ZERO
      INTEGER
     +   I,J
*
C...DATA STATEMENTS
      DATA
     +   ZERO
     +   /0.0E0/
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
C     REAL A(LDA,M)
C        THE ARRAY TO BE SET TO ZERO.
C     INTEGER I
C        AN INDEXING VARIABLE.
C     INTEGER J
C        AN INDEXING VARIABLE.
C     INTEGER LDA
C        THE LEADING DIMENSION OF ARRAY A.
C     INTEGER M
C        THE NUMBER OF COLUMNS OF DATA IN ARRAY A TO BE SET TO ZERO.
C     INTEGER N
C        THE NUMBER OF ROWS OF DATA IN ARRAY A TO BE SET TO ZERO.
C     REAL ZERO
C        THE VALUE 0.0E0.
*
*
C***FIRST EXECUTABLE STATEMENT  SZERO
*
*
      DO 20 J=1,M
         DO 10 I=1,N
            A(I,J) = ZERO
   10    CONTINUE
   20 CONTINUE
*
      RETURN
      END
*ISAMAX
      INTEGER FUNCTION ISAMAX(N,SX,INCX)
C***BEGIN PROLOGUE  ISAMAX
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A2
C***KEYWORDS  BLAS,LINEAR ALGEBRA,MAXIMUM COMPONENT,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  FIND LARGEST COMPONENT OF S.P. VECTOR
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C     --OUTPUT--
C   ISAMAX  SMALLEST INDEX (ZERO IF N .LE. 0)
C     FIND SMALLEST INDEX OF MAXIMUM MAGNITUDE OF SINGLE PRECISION SX.
C     ISAMAX =  FIRST I, I = 1 TO N, TO MINIMIZE  ABS(SX(1-INCX+I*INCX)
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  ISAMAX
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      REAL SX(*)
*
C...LOCAL SCALARS
      REAL SMAX,XMAG
      INTEGER
     +   I,II,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS
*
*
C***FIRST EXECUTABLE STATEMENT  ISAMAX
*
*
      ISAMAX = 0
      IF(N.LE.0) RETURN
      ISAMAX = 1
      IF(N.LE.1)RETURN
      IF(INCX.EQ.1)GOTO 20
*
C        CODE FOR INCREMENTS NOT EQUAL TO 1.
*
      SMAX = ABS(SX(1))
      NS = N*INCX
      II = 1
          DO 10 I=1,NS,INCX
          XMAG = ABS(SX(I))
          IF(XMAG.LE.SMAX) GO TO 5
          ISAMAX = II
          SMAX = XMAG
    5     II = II + 1
   10     CONTINUE
      RETURN
*
C        CODE FOR INCREMENTS EQUAL TO 1.
*
   20 SMAX = ABS(SX(1))
      DO 30 I = 2,N
         XMAG = ABS(SX(I))
         IF(XMAG.LE.SMAX) GO TO 30
         ISAMAX = I
         SMAX = XMAG
   30 CONTINUE
      RETURN
      END
*SASUM
      REAL FUNCTION SASUM(N,SX,INCX)
C***BEGIN PROLOGUE  SASUM
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A3A
C***KEYWORDS  ADD,BLAS,LINEAR ALGEBRA,MAGNITUDE,SUM,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  SUM OF MAGNITUDES OF S.P VECTOR COMPONENTS
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C     --OUTPUT--
C    SASUM  SINGLE PRECISION RESULT (ZERO IF N .LE. 0)
C     RETURNS SUM OF MAGNITUDES OF SINGLE PRECISION SX.
C     SASUM = SUM FROM 0 TO N-1 OF  ABS(SX(1+I*INCX))
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SASUM
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      REAL SX(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SASUM
*
*
      SASUM = 0.0E0
      IF(N.LE.0)RETURN
      IF(INCX.EQ.1)GOTO 20
*
C        CODE FOR INCREMENTS NOT EQUAL TO 1.
*
      NS = N*INCX
          DO 10 I=1,NS,INCX
          SASUM = SASUM + ABS(SX(I))
   10     CONTINUE
      RETURN
*
C        CODE FOR INCREMENTS EQUAL TO 1.
*
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 6.
*
   20 M = MOD(N,6)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        SASUM = SASUM + ABS(SX(I))
   30 CONTINUE
      IF( N .LT. 6 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,6
        SASUM = SASUM + ABS(SX(I)) + ABS(SX(I + 1)) + ABS(SX(I + 2))
     1  + ABS(SX(I + 3)) + ABS(SX(I + 4)) + ABS(SX(I + 5))
   50 CONTINUE
      RETURN
      END
*SAXPY
      SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
C***BEGIN PROLOGUE  SAXPY
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A7
C***KEYWORDS  BLAS,LINEAR ALGEBRA,TRIAD,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  S.P. COMPUTATION Y = A*X + Y
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SA  SINGLE PRECISION SCALAR MULTIPLIER
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C       SY  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF SY
C     --OUTPUT--
C       SY  SINGLE PRECISION RESULT (UNCHANGED IF N .LE. 0)
C     OVERWRITE SINGLE PRECISION SY WITH SINGLE PRECISION SA*SX +SY.
C     FOR I = 0 TO N-1, REPLACE  SY(LY+I*INCY) WITH SA*SX(LX+I*INCX) +
C       SY(LY+I*INCY), WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N
C       AND LY IS DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SAXPY
*
C...SCALAR ARGUMENTS
      REAL SA
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      REAL SX(*),SY(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SAXPY
*
*
      IF(N.LE.0.OR.SA.EQ.0.E0) RETURN
      IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60
    5 CONTINUE
*
C        CODE FOR NONEQUAL OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
        SY(IY) = SY(IY) + SA*SX(IX)
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C        CODE FOR BOTH INCREMENTS EQUAL TO 1
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 4.
*
   20 M = MOD(N,4)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        SY(I) = SY(I) + SA*SX(I)
   30 CONTINUE
      IF( N .LT. 4 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,4
        SY(I) = SY(I) + SA*SX(I)
        SY(I + 1) = SY(I + 1) + SA*SX(I + 1)
        SY(I + 2) = SY(I + 2) + SA*SX(I + 2)
        SY(I + 3) = SY(I + 3) + SA*SX(I + 3)
   50 CONTINUE
      RETURN
*
C        CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
*
   60 CONTINUE
      NS = N*INCX
          DO 70 I=1,NS,INCX
          SY(I) = SA*SX(I) + SY(I)
   70     CONTINUE
      RETURN
      END
*SCHEX
      SUBROUTINE SCHEX(R,LDR,P,K,L,Z,LDZ,NZ,C,S,JOB)
C***BEGIN PROLOGUE  SCHEX
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D7B
C***KEYWORDS  CHOLESKY DECOMPOSITION,EXCHANGE,LINEAR ALGEBRA,LINPACK,
C             MATRIX,POSITIVE DEFINITE
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  UPDATES THE CHOLESKY FACTORIZATION  A=TRANS(R)*R  OF A
C            POSITIVE DEFINITE MATRIX A OF ORDER P UNDER DIAGONAL
C            PERMUTATIONS OF THE FORM TRANS(E)*A*E   WHERE E IS A
C            PERMUTATION MATRIX.
C***DESCRIPTION
C     SCHEX UPDATES THE CHOLESKY FACTORIZATION
C                   A = TRANS(R)*R
C     OF A POSITIVE DEFINITE MATRIX A OF ORDER P UNDER DIAGONAL
C     PERMUTATIONS OF THE FORM
C                   TRANS(E)*A*E
C     WHERE E IS A PERMUTATION MATRIX.  SPECIFICALLY, GIVEN
C     AN UPPER TRIANGULAR MATRIX R AND A PERMUTATION MATRIX
C     E (WHICH IS SPECIFIED BY K, L, AND JOB), SCHEX DETERMINES
C     AN ORTHOGONAL MATRIX U SUCH THAT
C                           U*R*E = RR,
C     WHERE RR IS UPPER TRIANGULAR.  AT THE USERS OPTION, THE
C     TRANSFORMATION U WILL BE MULTIPLIED INTO THE ARRAY Z.
C     IF A = TRANS(X)*X, SO THAT R IS THE TRIANGULAR PART OF THE
C     QR FACTORIZATION OF X, THEN RR IS THE TRIANGULAR PART OF THE
C     QR FACTORIZATION OF X*E, I.E., X WITH ITS COLUMNS PERMUTED.
C     FOR A LESS TERSE DESCRIPTION OF WHAT SCHEX DOES AND HOW
C     IT MAY BE APPLIED, SEE THE LINPACK GUIDE.
C     THE MATRIX Q IS DETERMINED AS THE PRODUCT U(L-K)*...*U(1)
C     OF PLANE ROTATIONS OF THE FORM
C                           (    C(I)       S(I) )
C                           (                    ) ,
C                           (    -S(I)      C(I) )
C     WHERE C(I) IS REAL.  THE ROWS THESE ROTATIONS OPERATE ON
C     ARE DESCRIBED BELOW.
C     THERE ARE TWO TYPES OF PERMUTATIONS, WHICH ARE DETERMINED
C     BY THE VALUE OF JOB.
C     1. RIGHT CIRCULAR SHIFT (JOB = 1).
C         THE COLUMNS ARE REARRANGED IN THE FOLLOWING ORDER.
C                1,...,K-1,L,K,K+1,...,L-1,L+1,...,P.
C         U IS THE PRODUCT OF L-K ROTATIONS U(I), WHERE U(I)
C         ACTS IN THE (L-I,L-I+1)-PLANE.
C     2. LEFT CIRCULAR SHIFT (JOB = 2).
C         THE COLUMNS ARE REARRANGED IN THE FOLLOWING ORDER
C                1,...,K-1,K+1,K+2,...,L,K,L+1,...,P.
C         U IS THE PRODUCT OF L-K ROTATIONS U(I), WHERE U(I)
C         ACTS IN THE (K+I-1,K+I)-PLANE.
C     ON ENTRY
C         R      REAL(LDR,P), WHERE LDR .GE. P.
C                R CONTAINS THE UPPER TRIANGULAR FACTOR
C                THAT IS TO BE UPDATED.  ELEMENTS OF R
C                BELOW THE DIAGONAL ARE NOT REFERENCED.
C         LDR    INTEGER.
C                LDR IS THE LEADING DIMENSION OF THE ARRAY R.
C         P      INTEGER.
C                P IS THE ORDER OF THE MATRIX R.
C         K      INTEGER.
C                K IS THE FIRST COLUMN TO BE PERMUTED.
C         L      INTEGER.
C                L IS THE LAST COLUMN TO BE PERMUTED.
C                L MUST BE STRICTLY GREATER THAN K.
C         Z      REAL(LDZ,NZ), WHERE LDZ.GE.P.
C                Z IS AN ARRAY OF NZ P-VECTORS INTO WHICH THE
C                TRANSFORMATION U IS MULTIPLIED.  Z IS
C                NOT REFERENCED IF NZ = 0.
C         LDZ    INTEGER.
C                LDZ IS THE LEADING DIMENSION OF THE ARRAY Z.
C         NZ     INTEGER.
C                NZ IS THE NUMBER OF COLUMNS OF THE MATRIX Z.
C         JOB    INTEGER.
C                JOB DETERMINES THE TYPE OF PERMUTATION.
C                       JOB = 1  RIGHT CIRCULAR SHIFT.
C                       JOB = 2  LEFT CIRCULAR SHIFT.
C     ON RETURN
C         R      CONTAINS THE UPDATED FACTOR.
C         Z      CONTAINS THE UPDATED MATRIX Z.
C         C      REAL(P).
C                C CONTAINS THE COSINES OF THE TRANSFORMING ROTATIONS.
C         S      REAL(P).
C                S CONTAINS THE SINES OF THE TRANSFORMING ROTATIONS.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  SROTG
C***END PROLOGUE  SCHEX
*
C...SCALAR ARGUMENTS
      INTEGER
     +   JOB,K,L,LDR,LDZ,NZ,P
*
C...ARRAY ARGUMENTS
      REAL C(*),R(LDR,*),S(*),Z(LDZ,*)
*
C...LOCAL SCALARS
      REAL T,T1
      INTEGER
     +   I,II,IL,IU,J,JJ,KM1,KP1,LM1,LMK
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SROTG
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MAX0,MIN0
*
*
C***FIRST EXECUTABLE STATEMENT  SCHEX
*
*
      KM1 = K - 1
      KP1 = K + 1
      LMK = L - K
      LM1 = L - 1
*
C     PERFORM THE APPROPRIATE TASK.
*
      GO TO (10,130), JOB
*
C     RIGHT CIRCULAR SHIFT.
*
   10 CONTINUE
*
C        REORDER THE COLUMNS.
*
         DO 20 I = 1, L
            II = L - I + 1
            S(I) = R(II,L)
   20    CONTINUE
         DO 40 JJ = K, LM1
            J = LM1 - JJ + K
            DO 30 I = 1, J
               R(I,J+1) = R(I,J)
   30       CONTINUE
            R(J+1,J+1) = 0.0E0
   40    CONTINUE
         IF (K .EQ. 1) GO TO 60
            DO 50 I = 1, KM1
               II = L - I + 1
               R(I,K) = S(II)
   50       CONTINUE
   60    CONTINUE
*
C        CALCULATE THE ROTATIONS.
*
         T = S(1)
         DO 70 I = 1, LMK
            T1 = S(I)
            CALL SROTG(S(I+1),T,C(I),T1)
            S(I) = T1
            T = S(I+1)
   70    CONTINUE
         R(K,K) = T
         DO 90 J = KP1, P
            IL = MAX0(1,L-J+1)
            DO 80 II = IL, LMK
               I = L - II
               T = C(II)*R(I,J) + S(II)*R(I+1,J)
               R(I+1,J) = C(II)*R(I+1,J) - S(II)*R(I,J)
               R(I,J) = T
   80       CONTINUE
   90    CONTINUE
*
C        IF REQUIRED, APPLY THE TRANSFORMATIONS TO Z.
*
         IF (NZ .LT. 1) GO TO 120
         DO 110 J = 1, NZ
            DO 100 II = 1, LMK
               I = L - II
               T = C(II)*Z(I,J) + S(II)*Z(I+1,J)
               Z(I+1,J) = C(II)*Z(I+1,J) - S(II)*Z(I,J)
               Z(I,J) = T
  100       CONTINUE
  110    CONTINUE
  120    CONTINUE
      GO TO 260
*
C     LEFT CIRCULAR SHIFT
*
  130 CONTINUE
*
C        REORDER THE COLUMNS
*
         DO 140 I = 1, K
            II = LMK + I
            S(II) = R(I,K)
  140    CONTINUE
         DO 160 J = K, LM1
            DO 150 I = 1, J
               R(I,J) = R(I,J+1)
  150       CONTINUE
            JJ = J - KM1
            S(JJ) = R(J+1,J+1)
  160    CONTINUE
         DO 170 I = 1, K
            II = LMK + I
            R(I,L) = S(II)
  170    CONTINUE
         DO 180 I = KP1, L
            R(I,L) = 0.0E0
  180    CONTINUE
*
C        REDUCTION LOOP.
*
         DO 220 J = K, P
            IF (J .EQ. K) GO TO 200
*
C              APPLY THE ROTATIONS.
*
               IU = MIN0(J-1,L-1)
               DO 190 I = K, IU
                  II = I - K + 1
                  T = C(II)*R(I,J) + S(II)*R(I+1,J)
                  R(I+1,J) = C(II)*R(I+1,J) - S(II)*R(I,J)
                  R(I,J) = T
  190          CONTINUE
  200       CONTINUE
            IF (J .GE. L) GO TO 210
               JJ = J - K + 1
               T = S(JJ)
               CALL SROTG(R(J,J),T,C(JJ),S(JJ))
  210       CONTINUE
  220    CONTINUE
*
C        APPLY THE ROTATIONS TO Z.
*
         IF (NZ .LT. 1) GO TO 250
         DO 240 J = 1, NZ
            DO 230 I = K, LM1
               II = I - KM1
               T = C(II)*Z(I,J) + S(II)*Z(I+1,J)
               Z(I+1,J) = C(II)*Z(I+1,J) - S(II)*Z(I,J)
               Z(I,J) = T
  230       CONTINUE
  240    CONTINUE
  250    CONTINUE
  260 CONTINUE
      RETURN
      END
*SCOPY
      SUBROUTINE SCOPY(N,SX,INCX,SY,INCY)
C***BEGIN PROLOGUE  SCOPY
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A5
C***KEYWORDS  BLAS,COPY,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  COPY S.P. VECTOR Y = X
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C       SY  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF SY
C     --OUTPUT--
C       SY  COPY OF VECTOR SX (UNCHANGED IF N .LE. 0)
C     COPY SINGLE PRECISION SX TO SINGLE PRECISION SY.
C     FOR I = 0 TO N-1, COPY  SX(LX+I*INCX) TO SY(LY+I*INCY),
C     WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS
C     DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SCOPY
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      REAL SX(*),SY(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SCOPY
*
*
      IF(N.LE.0)RETURN
      IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60
    5 CONTINUE
*
C        CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
        SY(IY) = SX(IX)
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C        CODE FOR BOTH INCREMENTS EQUAL TO 1
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 7.
*
   20 M = MOD(N,7)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        SY(I) = SX(I)
   30 CONTINUE
      IF( N .LT. 7 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,7
        SY(I) = SX(I)
        SY(I + 1) = SX(I + 1)
        SY(I + 2) = SX(I + 2)
        SY(I + 3) = SX(I + 3)
        SY(I + 4) = SX(I + 4)
        SY(I + 5) = SX(I + 5)
        SY(I + 6) = SX(I + 6)
   50 CONTINUE
      RETURN
*
C        CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
*
   60 CONTINUE
      NS = N*INCX
          DO 70 I=1,NS,INCX
          SY(I) = SX(I)
   70     CONTINUE
      RETURN
      END
*SDOT
      REAL FUNCTION SDOT(N,SX,INCX,SY,INCY)
C***BEGIN PROLOGUE  SDOT
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A4
C***KEYWORDS  BLAS,INNER PRODUCT,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  S.P. INNER PRODUCT OF S.P. VECTORS
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C       SY  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF SY
C     --OUTPUT--
C     SDOT  SINGLE PRECISION DOT PRODUCT (ZERO IF N .LE. 0)
C     RETURNS THE DOT PRODUCT OF SINGLE PRECISION SX AND SY.
C     SDOT = SUM FOR I = 0 TO N-1 OF  SX(LX+I*INCX) * SY(LY+I*INCY),
C     WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS
C     DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SDOT
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      REAL SX(*),SY(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SDOT
*
*
      SDOT = 0.0E0
      IF(N.LE.0)RETURN
      IF(INCX.EQ.INCY) IF(INCX-1)5,20,60
    5 CONTINUE
*
C        CODE FOR UNEQUAL INCREMENTS OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
        SDOT = SDOT + SX(IX)*SY(IY)
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C        CODE FOR BOTH INCREMENTS EQUAL TO 1
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5.
*
   20 M = MOD(N,5)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        SDOT = SDOT + SX(I)*SY(I)
   30 CONTINUE
      IF( N .LT. 5 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,5
        SDOT = SDOT + SX(I)*SY(I) + SX(I + 1)*SY(I + 1) +
     1   SX(I + 2)*SY(I + 2) + SX(I + 3)*SY(I + 3) + SX(I + 4)*SY(I + 4)
   50 CONTINUE
      RETURN
*
C        CODE FOR POSITIVE EQUAL INCREMENTS .NE.1.
*
   60 CONTINUE
      NS=N*INCX
      DO 70 I=1,NS,INCX
        SDOT = SDOT + SX(I)*SY(I)
   70   CONTINUE
      RETURN
      END
*SNRM2
      REAL FUNCTION SNRM2(N,SX,INCX)
C***BEGIN PROLOGUE  SNRM2
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A3B
C***KEYWORDS  BLAS,EUCLIDEAN,L2,LENGTH,LINEAR ALGEBRA,NORM,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  EUCLIDEAN LENGTH (L2 NORM) OF S.P. VECTOR
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C     --OUTPUT--
C    SNRM2  SINGLE PRECISION RESULT (ZERO IF N .LE. 0)
C     EUCLIDEAN NORM OF THE N-VECTOR STORED IN SX() WITH STORAGE
C     INCREMENT INCX .
C     IF N .LE. 0, RETURN WITH RESULT = 0.
C     IF N .GE. 1, THEN INCX MUST BE .GE. 1
C           C. L. LAWSON, 1978 JAN 08
C     FOUR PHASE METHOD     USING TWO BUILT-IN CONSTANTS THAT ARE
C     HOPEFULLY APPLICABLE TO ALL MACHINES.
C         CUTLO = MAXIMUM OF  SQRT(U/EPS)  OVER ALL KNOWN MACHINES.
C         CUTHI = MINIMUM OF  SQRT(V)      OVER ALL KNOWN MACHINES.
C     WHERE
C         EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1.
C         U   = SMALLEST POSITIVE NO.   (UNDERFLOW LIMIT)
C         V   = LARGEST  NO.            (OVERFLOW  LIMIT)
C     BRIEF OUTLINE OF ALGORITHM..
C     PHASE 1 SCANS ZERO COMPONENTS.
C     MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO
C     MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO
C     MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M
C     WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX.
C     VALUES FOR CUTLO AND CUTHI..
C     FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER
C     DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS..
C     CUTLO, S.P.   U/EPS = 2**(-102) FOR  HONEYWELL.  CLOSE SECONDS ARE
C                   UNIVAC AND DEC AT 2**(-103)
C                   THUS CUTLO = 2**(-51) = 4.44089E-16
C     CUTHI, S.P.   V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC.
C                   THUS CUTHI = 2**(63.5) = 1.30438E19
C     CUTLO, D.P.   U/EPS = 2**(-67) FOR HONEYWELL AND DEC.
C                   THUS CUTLO = 2**(-33.5) = 8.23181D-11
C     CUTHI, D.P.   SAME AS S.P.  CUTHI = 1.30438D19
C     DATA CUTLO, CUTHI / 8.232D-11,  1.304D19 /
C     DATA CUTLO, CUTHI / 4.441E-16,  1.304E19 /
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SNRM2
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      REAL SX(*)
*
C...LOCAL SCALARS
      REAL CUTHI,CUTLO,HITEST,ONE,SUM,XMAX,ZERO
      INTEGER
     +   I,J,NEXT,NN
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,FLOAT,SQRT
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE/0.0E0,1.0E0/
      DATA
     +   CUTLO,CUTHI/4.441E-16,1.304E19/
*
*
C***FIRST EXECUTABLE STATEMENT  SNRM2
*
*
      XMAX = ZERO
      IF(N .GT. 0) GO TO 10
         SNRM2  = ZERO
         GO TO 300
*
   10 ASSIGN 30 TO NEXT
      SUM = ZERO
      NN = N * INCX
C                                                 BEGIN MAIN LOOP
      I = 1
C  20 GO TO NEXT,(30, 50, 70, 110)
   20 GO TO NEXT
   30 IF( ABS(SX(I)) .GT. CUTLO) GO TO 85
      ASSIGN 50 TO NEXT
      XMAX = ZERO
*
C                        PHASE 1.  SUM IS ZERO
*
   50 IF( SX(I) .EQ. ZERO) GO TO 200
      IF( ABS(SX(I)) .GT. CUTLO) GO TO 85
*
C                                PREPARE FOR PHASE 2.
      ASSIGN 70 TO NEXT
      GO TO 105
*
C                                PREPARE FOR PHASE 4.
*
  100 I = J
      ASSIGN 110 TO NEXT
      SUM = (SUM / SX(I)) / SX(I)
  105 XMAX = ABS(SX(I))
      GO TO 115
*
C                   PHASE 2.  SUM IS SMALL.
C                             SCALE TO AVOID DESTRUCTIVE UNDERFLOW.
*
   70 IF( ABS(SX(I)) .GT. CUTLO ) GO TO 75
*
C                     COMMON CODE FOR PHASES 2 AND 4.
C                     IN PHASE 4 SUM IS LARGE.  SCALE TO AVOID OVERFLOW.
*
  110 IF( ABS(SX(I)) .LE. XMAX ) GO TO 115
         SUM = ONE + SUM * (XMAX / SX(I))**2
         XMAX = ABS(SX(I))
         GO TO 200
*
  115 SUM = SUM + (SX(I)/XMAX)**2
      GO TO 200
*
*
C                  PREPARE FOR PHASE 3.
*
   75 SUM = (SUM * XMAX) * XMAX
*
*
C     FOR REAL OR D.P. SET HITEST = CUTHI/N
C     FOR COMPLEX      SET HITEST = CUTHI/(2*N)
*
   85 HITEST = CUTHI/FLOAT( N )
*
C                   PHASE 3.  SUM IS MID-RANGE.  NO SCALING.
*
      DO 95 J =I,NN,INCX
      IF(ABS(SX(J)) .GE. HITEST) GO TO 100
   95    SUM = SUM + SX(J)**2
      SNRM2 = SQRT( SUM )
      GO TO 300
*
  200 CONTINUE
      I = I + INCX
      IF ( I .LE. NN ) GO TO 20
*
C              END OF MAIN LOOP.
*
C              COMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
*
      SNRM2 = XMAX * SQRT(SUM)
  300 CONTINUE
      RETURN
      END
*SPODI
      SUBROUTINE SPODI(A,LDA,N,DET,JOB)
C***BEGIN PROLOGUE  SPODI
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D2B1B,D3B1B
C***KEYWORDS  DETERMINANT,FACTOR,INVERSE,LINEAR ALGEBRA,LINPACK,MATRIX,
C             POSITIVE DEFINITE
C***AUTHOR  MOLER, C. B., (U. OF NEW MEXICO)
C***PURPOSE  COMPUTES THE DETERMINANT AND INVERSE OF A CERTAIN
C            REAL SYMMETRIC POSITIVE DEFINITE MATRIX (SEE ABSTRACT)
C            USING THE FACTORS COMPUTED BY SPOCO, SPOFA OR SQRDC.
C***DESCRIPTION
C     SPODI COMPUTES THE DETERMINANT AND INVERSE OF A CERTAIN
C     REAL SYMMETRIC POSITIVE DEFINITE MATRIX (SEE BELOW)
C     USING THE FACTORS COMPUTED BY SPOCO, SPOFA OR SQRDC.
C     ON ENTRY
C        A       REAL(LDA, N)
C                THE OUTPUT  A  FROM SPOCO OR SPOFA
C                OR THE OUTPUT  X  FROM SQRDC.
C        LDA     INTEGER
C                THE LEADING DIMENSION OF THE ARRAY  A .
C        N       INTEGER
C                THE ORDER OF THE MATRIX  A .
C        JOB     INTEGER
C                = 11   BOTH DETERMINANT AND INVERSE.
C                = 01   INVERSE ONLY.
C                = 10   DETERMINANT ONLY.
C     ON RETURN
C        A       IF SPOCO OR SPOFA WAS USED TO FACTOR  A , THEN
C                SPODI PRODUCES THE UPPER HALF OF INVERSE(A) .
C                IF SQRDC WAS USED TO DECOMPOSE  X , THEN
C                SPODI PRODUCES THE UPPER HALF OF INVERSE(TRANS(X)*X),
C                WHERE TRANS(X) IS THE TRANSPOSE.
C                ELEMENTS OF  A  BELOW THE DIAGONAL ARE UNCHANGED.
C                IF THE UNITS DIGIT OF JOB IS ZERO,  A  IS UNCHANGED.
C        DET     REAL(2)
C                DETERMINANT OF  A  OR OF  TRANS(X)*X  IF REQUESTED.
C                OTHERWISE NOT REFERENCED.
C                DETERMINANT = DET(1) * 10.0**DET(2)
C                WITH  1.0 .LE. DET(1) .LT. 10.0
C                OR  DET(1) .EQ. 0.0 .
C     ERROR CONDITION
C        A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS
C        A ZERO ON THE DIAGONAL AND THE INVERSE IS REQUESTED.
C        IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED CORRECTLY
C        AND IF SPOCO OR SPOFA HAS SET INFO .EQ. 0 .
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  SAXPY,SSCAL
C***END PROLOGUE  SPODI
*
C...SCALAR ARGUMENTS
      INTEGER JOB,LDA,N
*
C...ARRAY ARGUMENTS
      REAL A(LDA,*),DET(*)
*
C...LOCAL SCALARS
      REAL S,T
      INTEGER I,J,JM1,K,KP1
*
C...EXTERNAL SUBROUTINES
      EXTERNAL SAXPY,SSCAL
*
C...INTRINSIC FUNCTIONS
      INTRINSIC MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SPODI
*
*
      IF (JOB/10 .EQ. 0) GO TO 70
         DET(1) = 1.0E0
         DET(2) = 0.0E0
         S = 10.0E0
         DO 50 I = 1, N
            DET(1) = A(I,I)**2*DET(1)
C        ...EXIT
            IF (DET(1) .EQ. 0.0E0) GO TO 60
   10       IF (DET(1) .GE. 1.0E0) GO TO 20
               DET(1) = S*DET(1)
               DET(2) = DET(2) - 1.0E0
            GO TO 10
   20       CONTINUE
   30       IF (DET(1) .LT. S) GO TO 40
               DET(1) = DET(1)/S
               DET(2) = DET(2) + 1.0E0
            GO TO 30
   40       CONTINUE
   50    CONTINUE
   60    CONTINUE
   70 CONTINUE
*
C     COMPUTE INVERSE(R)
*
      IF (MOD(JOB,10) .EQ. 0) GO TO 140
         DO 100 K = 1, N
            A(K,K) = 1.0E0/A(K,K)
            T = -A(K,K)
            CALL SSCAL(K-1,T,A(1,K),1)
            KP1 = K + 1
            IF (N .LT. KP1) GO TO 90
            DO 80 J = KP1, N
               T = A(K,J)
               A(K,J) = 0.0E0
               CALL SAXPY(K,T,A(1,K),1,A(1,J),1)
   80       CONTINUE
   90       CONTINUE
  100    CONTINUE
*
C        FORM  INVERSE(R) * TRANS(INVERSE(R))
*
         DO 130 J = 1, N
            JM1 = J - 1
            IF (JM1 .LT. 1) GO TO 120
            DO 110 K = 1, JM1
               T = A(K,J)
               CALL SAXPY(K,T,A(1,J),1,A(1,K),1)
  110       CONTINUE
  120       CONTINUE
            T = A(J,J)
            CALL SSCAL(J,T,A(1,J),1)
  130    CONTINUE
  140 CONTINUE
      RETURN
      END
*SQRDC
      SUBROUTINE SQRDC(X,LDX,N,P,QRAUX,JPVT,WORK,JOB)
C***BEGIN PROLOGUE  SQRDC
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D5
C***KEYWORDS  DECOMPOSITION,LINEAR ALGEBRA,LINPACK,MATRIX,
C             ORTHOGONAL TRIANGULAR
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  USES HOUSEHOLDER TRANSFORMATIONS TO COMPUTE THE QR
C            FACTORIZATION OF AN N BY P MATRIX X.  COLUMN PIVOTING IS
C            A USERS OPTION.
C***DESCRIPTION
C     SQRDC USES HOUSEHOLDER TRANSFORMATIONS TO COMPUTE THE QR
C     FACTORIZATION OF AN N BY P MATRIX X.  COLUMN PIVOTING
C     BASED ON THE 2-NORMS OF THE REDUCED COLUMNS MAY BE
C     PERFORMED AT THE USER'S OPTION.
C     ON ENTRY
C        X       REAL(LDX,P), WHERE LDX .GE. N.
C                X CONTAINS THE MATRIX WHOSE DECOMPOSITION IS TO BE
C                COMPUTED.
C        LDX     INTEGER.
C                LDX IS THE LEADING DIMENSION OF THE ARRAY X.
C        N       INTEGER.
C                N IS THE NUMBER OF ROWS OF THE MATRIX X.
C        P       INTEGER.
C                P IS THE NUMBER OF COLUMNS OF THE MATRIX X.
C        JPVT    INTEGER(P).
C                JPVT CONTAINS INTEGERS THAT CONTROL THE SELECTION
C                OF THE PIVOT COLUMNS.  THE K-TH COLUMN X(K) OF X
C                IS PLACED IN ONE OF THREE CLASSES ACCORDING TO THE
C                VALUE OF JPVT(K).
C                   IF JPVT(K) .GT. 0, THEN X(K) IS AN INITIAL
C                                      COLUMN.
C                   IF JPVT(K) .EQ. 0, THEN X(K) IS A FREE COLUMN.
C                   IF JPVT(K) .LT. 0, THEN X(K) IS A FINAL COLUMN.
C                BEFORE THE DECOMPOSITION IS COMPUTED, INITIAL COLUMNS
C                ARE MOVED TO THE BEGINNING OF THE ARRAY X AND FINAL
C                COLUMNS TO THE END.  BOTH INITIAL AND FINAL COLUMNS
C                ARE FROZEN IN PLACE DURING THE COMPUTATION AND ONLY
C                FREE COLUMNS ARE MOVED.  AT THE K-TH STAGE OF THE
C                REDUCTION, IF X(K) IS OCCUPIED BY A FREE COLUMN,
C                IT IS INTERCHANGED WITH THE FREE COLUMN OF LARGEST
C                REDUCED NORM.  JPVT IS NOT REFERENCED IF
C                JOB .EQ. 0.
C        WORK    REAL(P).
C                WORK IS A WORK ARRAY.  WORK IS NOT REFERENCED IF
C                JOB .EQ. 0.
C        JOB     INTEGER.
C                JOB IS AN INTEGER THAT INITIATES COLUMN PIVOTING.
C                IF JOB .EQ. 0, NO PIVOTING IS DONE.
C                IF JOB .NE. 0, PIVOTING IS DONE.
C     ON RETURN
C        X       X CONTAINS IN ITS UPPER TRIANGLE THE UPPER
C                TRIANGULAR MATRIX R OF THE QR FACTORIZATION.
C                BELOW ITS DIAGONAL X CONTAINS INFORMATION FROM
C                WHICH THE ORTHOGONAL PART OF THE DECOMPOSITION
C                CAN BE RECOVERED.  NOTE THAT IF PIVOTING HAS
C                BEEN REQUESTED, THE DECOMPOSITION IS NOT THAT
C                OF THE ORIGINAL MATRIX X BUT THAT OF X
C                WITH ITS COLUMNS PERMUTED AS DESCRIBED BY JPVT.
C        QRAUX   REAL(P).
C                QRAUX CONTAINS FURTHER INFORMATION REQUIRED TO RECOVER
C                THE ORTHOGONAL PART OF THE DECOMPOSITION.
C        JPVT    JPVT(K) CONTAINS THE INDEX OF THE COLUMN OF THE
C                ORIGINAL MATRIX THAT HAS BEEN INTERCHANGED INTO
C                THE K-TH COLUMN, IF PIVOTING WAS REQUESTED.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  SAXPY,SDOT,SNRM2,SSCAL,SSWAP
C***END PROLOGUE  SQRDC
*
C...SCALAR ARGUMENTS
      INTEGER
     +   JOB,LDX,N,P
*
C...ARRAY ARGUMENTS
      REAL QRAUX(*),WORK(*),X(LDX,*)
      INTEGER
     +   JPVT(*)
*
C...LOCAL SCALARS
      REAL MAXNRM,NRMXL,T,TT
      INTEGER
     +   J,JJ,JP,L,LP1,LUP,MAXJ,PL,PU
      LOGICAL
     +   NEGJ,SWAPJ
*
C...EXTERNAL FUNCTIONS
      REAL SDOT,SNRM2
      EXTERNAL
     +   SDOT,SNRM2
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SAXPY,SSCAL,SSWAP
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,AMAX1,MIN0,SIGN,SQRT
*
*
C***FIRST EXECUTABLE STATEMENT  SQRDC
*
*
      PL = 1
      PU = 0
      IF (JOB .EQ. 0) GO TO 60
*
C        PIVOTING HAS BEEN REQUESTED.  REARRANGE THE COLUMNS
C        ACCORDING TO JPVT.
*
         DO 20 J = 1, P
            SWAPJ = JPVT(J) .GT. 0
            NEGJ = JPVT(J) .LT. 0
            JPVT(J) = J
            IF (NEGJ) JPVT(J) = -J
            IF (.NOT.SWAPJ) GO TO 10
               IF (J .NE. PL) CALL SSWAP(N,X(1,PL),1,X(1,J),1)
               JPVT(J) = JPVT(PL)
               JPVT(PL) = J
               PL = PL + 1
   10       CONTINUE
   20    CONTINUE
         PU = P
         DO 50 JJ = 1, P
            J = P - JJ + 1
            IF (JPVT(J) .GE. 0) GO TO 40
               JPVT(J) = -JPVT(J)
               IF (J .EQ. PU) GO TO 30
                  CALL SSWAP(N,X(1,PU),1,X(1,J),1)
                  JP = JPVT(PU)
                  JPVT(PU) = JPVT(J)
                  JPVT(J) = JP
   30          CONTINUE
               PU = PU - 1
   40       CONTINUE
   50    CONTINUE
   60 CONTINUE
*
C     COMPUTE THE NORMS OF THE FREE COLUMNS.
*
      IF (PU .LT. PL) GO TO 80
      DO 70 J = PL, PU
         QRAUX(J) = SNRM2(N,X(1,J),1)
         WORK(J) = QRAUX(J)
   70 CONTINUE
   80 CONTINUE
*
C     PERFORM THE HOUSEHOLDER REDUCTION OF X.
*
      LUP = MIN0(N,P)
      DO 200 L = 1, LUP
         IF (L .LT. PL .OR. L .GE. PU) GO TO 120
*
C           LOCATE THE COLUMN OF LARGEST NORM AND BRING IT
C           INTO THE PIVOT POSITION.
*
            MAXNRM = 0.0E0
            MAXJ = L
            DO 100 J = L, PU
               IF (QRAUX(J) .LE. MAXNRM) GO TO 90
                  MAXNRM = QRAUX(J)
                  MAXJ = J
   90          CONTINUE
  100       CONTINUE
            IF (MAXJ .EQ. L) GO TO 110
               CALL SSWAP(N,X(1,L),1,X(1,MAXJ),1)
               QRAUX(MAXJ) = QRAUX(L)
               WORK(MAXJ) = WORK(L)
               JP = JPVT(MAXJ)
               JPVT(MAXJ) = JPVT(L)
               JPVT(L) = JP
  110       CONTINUE
  120    CONTINUE
         QRAUX(L) = 0.0E0
         IF (L .EQ. N) GO TO 190
*
C           COMPUTE THE HOUSEHOLDER TRANSFORMATION FOR COLUMN L.
*
            NRMXL = SNRM2(N-L+1,X(L,L),1)
            IF (NRMXL .EQ. 0.0E0) GO TO 180
               IF (X(L,L) .NE. 0.0E0) NRMXL = SIGN(NRMXL,X(L,L))
               CALL SSCAL(N-L+1,1.0E0/NRMXL,X(L,L),1)
               X(L,L) = 1.0E0 + X(L,L)
*
C              APPLY THE TRANSFORMATION TO THE REMAINING COLUMNS,
C              UPDATING THE NORMS.
*
               LP1 = L + 1
               IF (P .LT. LP1) GO TO 170
               DO 160 J = LP1, P
                  T = -SDOT(N-L+1,X(L,L),1,X(L,J),1)/X(L,L)
                  CALL SAXPY(N-L+1,T,X(L,L),1,X(L,J),1)
                  IF (J .LT. PL .OR. J .GT. PU) GO TO 150
                  IF (QRAUX(J) .EQ. 0.0E0) GO TO 150
                     TT = 1.0E0 - (ABS(X(L,J))/QRAUX(J))**2
                     TT = AMAX1(TT,0.0E0)
                     T = TT
                     TT = 1.0E0 + 0.05E0*TT*(QRAUX(J)/WORK(J))**2
                     IF (TT .EQ. 1.0E0) GO TO 130
                        QRAUX(J) = QRAUX(J)*SQRT(T)
                     GO TO 140
  130                CONTINUE
                        QRAUX(J) = SNRM2(N-L,X(L+1,J),1)
                        WORK(J) = QRAUX(J)
  140                CONTINUE
  150             CONTINUE
  160          CONTINUE
  170          CONTINUE
*
C              SAVE THE TRANSFORMATION.
*
               QRAUX(L) = X(L,L)
               X(L,L) = -NRMXL
  180       CONTINUE
  190    CONTINUE
  200 CONTINUE
      RETURN
      END
*SQRSL
      SUBROUTINE SQRSL(X,LDX,N,K,QRAUX,Y,QY,QTY,B,RSD,XB,JOB,INFO)
C***BEGIN PROLOGUE  SQRSL
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D9,D2A1
C***KEYWORDS  LINEAR ALGEBRA,LINPACK,MATRIX,ORTHOGONAL TRIANGULAR,SOLVE
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  APPLIES THE OUTPUT OF SQRDC TO COMPUTE COORDINATE TRANS-
C            FORMATIONS PROJECTIONS, AND LEAST SQUARES SOLUTIONS.
C***DESCRIPTION
C     SQRSL APPLIES THE OUTPUT OF SQRDC TO COMPUTE COORDINATE
C     TRANSFORMATIONS, PROJECTIONS, AND LEAST SQUARES SOLUTIONS.
C     FOR K .LE. MIN(N,P), LET XK BE THE MATRIX
C            XK = (X(JPVT(1)),X(JPVT(2)), ... ,X(JPVT(K)))
C     FORMED FROM COLUMNNS JPVT(1), ... ,JPVT(K) OF THE ORIGINAL
C     N X P MATRIX X THAT WAS INPUT TO SQRDC (IF NO PIVOTING WAS
C     DONE, XK CONSISTS OF THE FIRST K COLUMNS OF X IN THEIR
C     ORIGINAL ORDER).  SQRDC PRODUCES A FACTORED ORTHOGONAL MATRIX Q
C     AND AN UPPER TRIANGULAR MATRIX R SUCH THAT
C              XK = Q * (R)
C                       (0)
C     THIS INFORMATION IS CONTAINED IN CODED FORM IN THE ARRAYS
C     X AND QRAUX.
C     ON ENTRY
C        X      REAL(LDX,P)
C               X CONTAINS THE OUTPUT OF SQRDC.
C        LDX    INTEGER
C               LDX IS THE LEADING DIMENSION OF THE ARRAY X.
C        N      INTEGER
C               N IS THE NUMBER OF ROWS OF THE MATRIX XK.  IT MUST
C               HAVE THE SAME VALUE AS N IN SQRDC.
C        K      INTEGER
C               K IS THE NUMBER OF COLUMNS OF THE MATRIX XK.  K
C               MUST NOT BE GREATER THAN MIN(N,P), WHERE P IS THE
C               SAME AS IN THE CALLING SEQUENCE TO SQRDC.
C        QRAUX  REAL(P)
C               QRAUX CONTAINS THE AUXILIARY OUTPUT FROM SQRDC.
C        Y      REAL(N)
C               Y CONTAINS AN N-VECTOR THAT IS TO BE MANIPULATED
C               BY SQRSL.
C        JOB    INTEGER
C               JOB SPECIFIES WHAT IS TO BE COMPUTED.  JOB HAS
C               THE DECIMAL EXPANSION ABCDE, WITH THE FOLLOWING
C               MEANING.
C                    IF A .NE. 0, COMPUTE QY.
C                    IF B,C,D, OR E .NE. 0, COMPUTE QTY.
C                    IF C .NE. 0, COMPUTE B.
C                    IF D .NE. 0, COMPUTE RSD.
C                    IF E .NE. 0, COMPUTE XB.
C               NOTE THAT A REQUEST TO COMPUTE B, RSD, OR XB
C               AUTOMATICALLY TRIGGERS THE COMPUTATION OF QTY, FOR
C               WHICH AN ARRAY MUST BE PROVIDED IN THE CALLING
C               SEQUENCE.
C     ON RETURN
C        QY     REAL(N).
C               QY CONTAINS Q*Y, IF ITS COMPUTATION HAS BEEN
C               REQUESTED.
C        QTY    REAL(N).
C               QTY CONTAINS TRANS(Q)*Y, IF ITS COMPUTATION HAS
C               BEEN REQUESTED.  HERE TRANS(Q) IS THE
C               TRANSPOSE OF THE MATRIX Q.
C        B      REAL(K)
C               B CONTAINS THE SOLUTION OF THE LEAST SQUARES PROBLEM
C                    MINIMIZE NORM2(Y - XK*B),
C               IF ITS COMPUTATION HAS BEEN REQUESTED.  (NOTE THAT
C               IF PIVOTING WAS REQUESTED IN SQRDC, THE J-TH
C               COMPONENT OF B WILL BE ASSOCIATED WITH COLUMN JPVT(J)
C               OF THE ORIGINAL MATRIX X THAT WAS INPUT INTO SQRDC.)
C        RSD    REAL(N).
C               RSD CONTAINS THE LEAST SQUARES RESIDUAL Y - XK*B,
C               IF ITS COMPUTATION HAS BEEN REQUESTED.  RSD IS
C               ALSO THE ORTHOGONAL PROJECTION OF Y ONTO THE
C               ORTHOGONAL COMPLEMENT OF THE COLUMN SPACE OF XK.
C        XB     REAL(N).
C               XB CONTAINS THE LEAST SQUARES APPROXIMATION XK*B,
C               IF ITS COMPUTATION HAS BEEN REQUESTED.  XB IS ALSO
C               THE ORTHOGONAL PROJECTION OF Y ONTO THE COLUMN SPACE
C               OF X.
C        INFO   INTEGER.
C               INFO IS ZERO UNLESS THE COMPUTATION OF B HAS
C               BEEN REQUESTED AND R IS EXACTLY SINGULAR.  IN
C               THIS CASE, INFO IS THE INDEX OF THE FIRST ZERO
C               DIAGONAL ELEMENT OF R AND B IS LEFT UNALTERED.
C     THE PARAMETERS QY, QTY, B, RSD, AND XB ARE NOT REFERENCED
C     IF THEIR COMPUTATION IS NOT REQUESTED AND IN THIS CASE
C     CAN BE REPLACED BY DUMMY VARIABLES IN THE CALLING PROGRAM.
C     TO SAVE STORAGE, THE USER MAY IN SOME CASES USE THE SAME
C     ARRAY FOR DIFFERENT PARAMETERS IN THE CALLING SEQUENCE.  A
C     FREQUENTLY OCCURING EXAMPLE IS WHEN ONE WISHES TO COMPUTE
C     ANY OF B, RSD, OR XB AND DOES NOT NEED Y OR QTY.  IN THIS
C     CASE ONE MAY IDENTIFY Y, QTY, AND ONE OF B, RSD, OR XB, WHILE
C     PROVIDING SEPARATE ARRAYS FOR ANYTHING ELSE THAT IS TO BE
C     COMPUTED.  THUS THE CALLING SEQUENCE
C          CALL SQRSL(X,LDX,N,K,QRAUX,Y,DUM,Y,B,Y,DUM,110,INFO)
C     WILL RESULT IN THE COMPUTATION OF B AND RSD, WITH RSD
C     OVERWRITING Y.  MORE GENERALLY, EACH ITEM IN THE FOLLOWING
C     LIST CONTAINS GROUPS OF PERMISSIBLE IDENTIFICATIONS FOR
C     A SINGLE CALLINNG SEQUENCE.
C          1. (Y,QTY,B) (RSD) (XB) (QY)
C          2. (Y,QTY,RSD) (B) (XB) (QY)
C          3. (Y,QTY,XB) (B) (RSD) (QY)
C          4. (Y,QY) (QTY,B) (RSD) (XB)
C          5. (Y,QY) (QTY,RSD) (B) (XB)
C          6. (Y,QY) (QTY,XB) (B) (RSD)
C     IN ANY GROUP THE VALUE RETURNED IN THE ARRAY ALLOCATED TO
C     THE GROUP CORRESPONDS TO THE LAST MEMBER OF THE GROUP.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  SAXPY,SCOPY,SDOT
C***END PROLOGUE  SQRSL
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,JOB,K,LDX,N
*
C...ARRAY ARGUMENTS
      REAL B(*),QRAUX(*),QTY(*),QY(*),RSD(*),X(LDX,*),XB(*),Y(*)
*
C...LOCAL SCALARS
      REAL T,TEMP
      INTEGER
     +   I,J,JJ,JU,KP1
      LOGICAL
     +   CB,CQTY,CQY,CR,CXB
*
C...EXTERNAL FUNCTIONS
      REAL SDOT
      EXTERNAL
     +   SDOT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SAXPY,SCOPY
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MIN0,MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SQRSL
*
*
C     SET INFO FLAG.
*
      INFO = 0
*
C     DETERMINE WHAT IS TO BE COMPUTED.
*
      CQY = JOB/10000 .NE. 0
      CQTY = MOD(JOB,10000) .NE. 0
      CB = MOD(JOB,1000)/100 .NE. 0
      CR = MOD(JOB,100)/10 .NE. 0
      CXB = MOD(JOB,10) .NE. 0
      JU = MIN0(K,N-1)
*
C     SPECIAL ACTION WHEN N=1.
*
      IF (JU .NE. 0) GO TO 40
         IF (CQY) QY(1) = Y(1)
         IF (CQTY) QTY(1) = Y(1)
         IF (CXB) XB(1) = Y(1)
         IF (.NOT.CB) GO TO 30
            IF (X(1,1) .NE. 0.0E0) GO TO 10
               INFO = 1
            GO TO 20
   10       CONTINUE
               B(1) = Y(1)/X(1,1)
   20       CONTINUE
   30    CONTINUE
         IF (CR) RSD(1) = 0.0E0
      GO TO 250
   40 CONTINUE
*
C        SET UP TO COMPUTE QY OR QTY.
*
         IF (CQY) CALL SCOPY(N,Y,1,QY,1)
         IF (CQTY) CALL SCOPY(N,Y,1,QTY,1)
         IF (.NOT.CQY) GO TO 70
*
C           COMPUTE QY.
*
            DO 60 JJ = 1, JU
               J = JU - JJ + 1
               IF (QRAUX(J) .EQ. 0.0E0) GO TO 50
                  TEMP = X(J,J)
                  X(J,J) = QRAUX(J)
                  T = -SDOT(N-J+1,X(J,J),1,QY(J),1)/X(J,J)
                  CALL SAXPY(N-J+1,T,X(J,J),1,QY(J),1)
                  X(J,J) = TEMP
   50          CONTINUE
   60       CONTINUE
   70    CONTINUE
         IF (.NOT.CQTY) GO TO 100
*
C           COMPUTE TRANS(Q)*Y.
*
            DO 90 J = 1, JU
               IF (QRAUX(J) .EQ. 0.0E0) GO TO 80
                  TEMP = X(J,J)
                  X(J,J) = QRAUX(J)
                  T = -SDOT(N-J+1,X(J,J),1,QTY(J),1)/X(J,J)
                  CALL SAXPY(N-J+1,T,X(J,J),1,QTY(J),1)
                  X(J,J) = TEMP
   80          CONTINUE
   90       CONTINUE
  100    CONTINUE
*
C        SET UP TO COMPUTE B, RSD, OR XB.
*
         IF (CB) CALL SCOPY(K,QTY,1,B,1)
         KP1 = K + 1
         IF (CXB) CALL SCOPY(K,QTY,1,XB,1)
         IF (CR .AND. K .LT. N) CALL SCOPY(N-K,QTY(KP1),1,RSD(KP1),1)
         IF (.NOT.CXB .OR. KP1 .GT. N) GO TO 120
            DO 110 I = KP1, N
               XB(I) = 0.0E0
  110       CONTINUE
  120    CONTINUE
         IF (.NOT.CR) GO TO 140
            DO 130 I = 1, K
               RSD(I) = 0.0E0
  130       CONTINUE
  140    CONTINUE
         IF (.NOT.CB) GO TO 190
*
C           COMPUTE B.
*
            DO 170 JJ = 1, K
               J = K - JJ + 1
               IF (X(J,J) .NE. 0.0E0) GO TO 150
                  INFO = J
C           ......EXIT
                  GO TO 180
  150          CONTINUE
               B(J) = B(J)/X(J,J)
               IF (J .EQ. 1) GO TO 160
                  T = -B(J)
                  CALL SAXPY(J-1,T,X(1,J),1,B,1)
  160          CONTINUE
  170       CONTINUE
  180       CONTINUE
  190    CONTINUE
         IF (.NOT.CR .AND. .NOT.CXB) GO TO 240
*
C           COMPUTE RSD OR XB AS REQUIRED.
*
            DO 230 JJ = 1, JU
               J = JU - JJ + 1
               IF (QRAUX(J) .EQ. 0.0E0) GO TO 220
                  TEMP = X(J,J)
                  X(J,J) = QRAUX(J)
                  IF (.NOT.CR) GO TO 200
                     T = -SDOT(N-J+1,X(J,J),1,RSD(J),1)/X(J,J)
                     CALL SAXPY(N-J+1,T,X(J,J),1,RSD(J),1)
  200             CONTINUE
                  IF (.NOT.CXB) GO TO 210
                     T = -SDOT(N-J+1,X(J,J),1,XB(J),1)/X(J,J)
                     CALL SAXPY(N-J+1,T,X(J,J),1,XB(J),1)
  210             CONTINUE
                  X(J,J) = TEMP
  220          CONTINUE
  230       CONTINUE
  240    CONTINUE
  250 CONTINUE
      RETURN
      END
*SROT
      SUBROUTINE SROT(N,SX,INCX,SY,INCY,SC,SS)
C***BEGIN PROLOGUE  SROT
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A8
C***KEYWORDS  BLAS,GIVENS ROTATION,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  APPLY S.P. GIVENS ROTATION
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C       SY  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF SY
C       SC  ELEMENT OF ROTATION MATRIX
C       SS  ELEMENT OF ROTATION MATRIX
C     --OUTPUT--
C       SX  ROTATED VECTOR SX (UNCHANGED IF N .LE. 0)
C       SY  ROTATED VECTOR SY (UNCHANGED IF N .LE. 0)
C     MULTIPLY THE 2 X 2 MATRIX  ( SC SS) TIMES THE 2 X N MATRIX (SX**T)
C                                (-SS SC)                        (SY**T)
C     WHERE **T INDICATES TRANSPOSE.  THE ELEMENTS OF SX ARE IN
C     SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
C     LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SROT
*
C...SCALAR ARGUMENTS
      REAL SC,SS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      REAL SX(*),SY(*)
*
C...LOCAL SCALARS
      REAL ONE,W,Z,ZERO
      INTEGER
     +   I,KX,KY,NSTEPS
*
C...DATA STATEMENTS
      DATA
     +   ZERO,ONE/0.E0,1.E0/
*
*
C***FIRST EXECUTABLE STATEMENT  SROT
*
*
      IF(N .LE. 0 .OR. (SS .EQ. ZERO .AND. SC .EQ. ONE)) GO TO 40
      IF(.NOT. (INCX .EQ. INCY .AND. INCX .GT. 0)) GO TO 20
*
           NSTEPS=INCX*N
           DO 10 I=1,NSTEPS,INCX
                W=SX(I)
                Z=SY(I)
                SX(I)=SC*W+SS*Z
                SY(I)=-SS*W+SC*Z
   10           CONTINUE
           GO TO 40
*
   20 CONTINUE
           KX=1
           KY=1
*
           IF(INCX .LT. 0) KX=1-(N-1)*INCX
           IF(INCY .LT. 0) KY=1-(N-1)*INCY
*
           DO 30 I=1,N
                W=SX(KX)
                Z=SY(KY)
                SX(KX)=SC*W+SS*Z
                SY(KY)=-SS*W+SC*Z
                KX=KX+INCX
                KY=KY+INCY
   30           CONTINUE
   40 CONTINUE
*
      RETURN
      END
*SROTG
      SUBROUTINE SROTG(SA,SB,SC,SS)
C***BEGIN PROLOGUE  SROTG
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1B10
C***KEYWORDS  BLAS,GIVENS ROTATION,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  CONSTRUCT S.P. PLANE GIVENS ROTATION
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C       SA  SINGLE PRECISION SCALAR
C       SB  SINGLE PRECISION SCALAR
C     --OUTPUT--
C       SA  SINGLE PRECISION RESULT R
C       SB  SINGLE PRECISION RESULT Z
C       SC  SINGLE PRECISION RESULT
C       SS  SINGLE PRECISION RESULT
C     DESIGNED BY C. L. LAWSON, JPL, 1977 SEPT 08
C     CONSTRUCT THE GIVENS TRANSFORMATION
C         ( SC  SS )
C     G = (        ) ,    SC**2 + SS**2 = 1 ,
C         (-SS  SC )
C     WHICH ZEROS THE SECOND ENTRY OF THE 2-VECTOR  (SA,SB)**T.
C     THE QUANTITY R = (+/-)SQRT(SA**2 + SB**2) OVERWRITES SA IN
C     STORAGE.  THE VALUE OF SB IS OVERWRITTEN BY A VALUE Z WHICH
C     ALLOWS SC AND SS TO BE RECOVERED BY THE FOLLOWING ALGORITHM@D
C           IF Z=1  SET  SC=0.  AND  SS=1.
C           IF ABS(Z) .LT. 1  SET  SC=SQRT(1-Z**2)  AND  SS=Z
C           IF ABS(Z) .GT. 1  SET  SC=1/Z  AND  SS=SQRT(1-SC**2)
C     NORMALLY, THE SUBPROGRAM SROT(N,SX,INCX,SY,INCY,SC,SS) WILL
C     NEXT BE CALLED TO APPLY THE TRANSFORMATION TO A 2 BY N MATRIX.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SROTG
*
C...SCALAR ARGUMENTS
      REAL SA,SB,SC,SS
*
C...LOCAL SCALARS
      REAL R,U,V
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,SQRT
*
*
C***FIRST EXECUTABLE STATEMENT  SROTG
*
*
      IF (ABS(SA) .LE. ABS(SB)) GO TO 10
*
C     *** HERE ABS(SA) .GT. ABS(SB) ***
*
      U = SA + SA
      V = SB / U
*
C     NOTE THAT U AND R HAVE THE SIGN OF SA
*
      R = SQRT(.25 + V**2) * U
*
C     NOTE THAT SC IS POSITIVE
*
      SC = SA / R
      SS = V * (SC + SC)
      SB = SS
      SA = R
      RETURN
*
C *** HERE ABS(SA) .LE. ABS(SB) ***
*
   10 IF (SB .EQ. 0.) GO TO 20
      U = SB + SB
      V = SA / U
*
C     NOTE THAT U AND R HAVE THE SIGN OF SB
C     (R IS IMMEDIATELY STORED IN SA)
*
      SA = SQRT(.25 + V**2) * U
*
C     NOTE THAT SS IS POSITIVE
*
      SS = SB / SA
      SC = V * (SS + SS)
      IF (SC .EQ. 0.) GO TO 15
      SB = 1. / SC
      RETURN
   15 SB = 1.
      RETURN
*
C *** HERE SA = SB = 0. ***
*
   20 SC = 1.
      SS = 0.
      RETURN
*
      END
*SSCAL
      SUBROUTINE SSCAL(N,SA,SX,INCX)
C***BEGIN PROLOGUE  SSCAL
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A6
C***KEYWORDS  BLAS,LINEAR ALGEBRA,SCALE,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  S.P. VECTOR SCALE X = A*X
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SA  SINGLE PRECISION SCALE FACTOR
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C     --OUTPUT--
C       SX  SINGLE PRECISION RESULT (UNCHANGED IF N .LE. 0)
C     REPLACE SINGLE PRECISION SX BY SINGLE PRECISION SA*SX.
C     FOR I = 0 TO N-1, REPLACE SX(1+I*INCX) WITH  SA * SX(1+I*INCX)
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SSCAL
*
C...SCALAR ARGUMENTS
      REAL SA
      INTEGER
     +   INCX,N
*
C...ARRAY ARGUMENTS
      REAL SX(*)
*
C...LOCAL SCALARS
      INTEGER
     +   I,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SSCAL
*
*
      IF(N.LE.0)RETURN
      IF(INCX.EQ.1)GOTO 20
*
C        CODE FOR INCREMENTS NOT EQUAL TO 1.
*
      NS = N*INCX
          DO 10 I = 1,NS,INCX
          SX(I) = SA*SX(I)
   10     CONTINUE
      RETURN
*
C        CODE FOR INCREMENTS EQUAL TO 1.
*
C        CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5.
*
   20 M = MOD(N,5)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        SX(I) = SA*SX(I)
   30 CONTINUE
      IF( N .LT. 5 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,5
        SX(I) = SA*SX(I)
        SX(I + 1) = SA*SX(I + 1)
        SX(I + 2) = SA*SX(I + 2)
        SX(I + 3) = SA*SX(I + 3)
        SX(I + 4) = SA*SX(I + 4)
   50 CONTINUE
      RETURN
      END
*SSWAP
      SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
C***BEGIN PROLOGUE  SSWAP
C***DATE WRITTEN   791001   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D1A5
C***KEYWORDS  BLAS,INTERCHANGE,LINEAR ALGEBRA,VECTOR
C***AUTHOR  LAWSON, C. L., (JPL)
C           HANSON, R. J., (SNLA)
C           KINCAID, D. R., (U. OF TEXAS)
C           KROGH, F. T., (JPL)
C***PURPOSE  INTERCHANGE S.P VECTORS
C***DESCRIPTION
C                B L A S  SUBPROGRAM
C    DESCRIPTION OF PARAMETERS
C     --INPUT--
C        N  NUMBER OF ELEMENTS IN INPUT VECTOR(S)
C       SX  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCX  STORAGE SPACING BETWEEN ELEMENTS OF SX
C       SY  SINGLE PRECISION VECTOR WITH N ELEMENTS
C     INCY  STORAGE SPACING BETWEEN ELEMENTS OF SY
C     --OUTPUT--
C       SX  INPUT VECTOR SY (UNCHANGED IF N .LE. 0)
C       SY  INPUT VECTOR SX (UNCHANGED IF N .LE. 0)
C     INTERCHANGE SINGLE PRECISION SX AND SINGLE PRECISION SY.
C     FOR I = 0 TO N-1, INTERCHANGE  SX(LX+I*INCX) AND SY(LY+I*INCY),
C     WHERE LX = 1 IF INCX .GE. 0, ELSE LX = (-INCX)*N, AND LY IS
C     DEFINED IN A SIMILAR WAY USING INCY.
C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  SSWAP
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INCX,INCY,N
*
C...ARRAY ARGUMENTS
      REAL SX(*),SY(*)
*
C...LOCAL SCALARS
      REAL STEMP1,STEMP2,STEMP3
      INTEGER
     +   I,IX,IY,M,MP1,NS
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  SSWAP
*
*
      IF(N.LE.0)RETURN
      IF(INCX.EQ.INCY) IF(INCX-1) 5,20,60
    5 CONTINUE
*
C       CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS.
*
      IX = 1
      IY = 1
      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
      DO 10 I = 1,N
        STEMP1 = SX(IX)
        SX(IX) = SY(IY)
        SY(IY) = STEMP1
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
*
C       CODE FOR BOTH INCREMENTS EQUAL TO 1
*
*
C       CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 3.
*
   20 M = MOD(N,3)
      IF( M .EQ. 0 ) GO TO 40
      DO 30 I = 1,M
        STEMP1 = SX(I)
        SX(I) = SY(I)
        SY(I) = STEMP1
   30 CONTINUE
      IF( N .LT. 3 ) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,3
        STEMP1 = SX(I)
        STEMP2 = SX(I+1)
        STEMP3 = SX(I+2)
        SX(I) = SY(I)
        SX(I+1) = SY(I+1)
        SX(I+2) = SY(I+2)
        SY(I) = STEMP1
        SY(I+1) = STEMP2
        SY(I+2) = STEMP3
   50 CONTINUE
      RETURN
   60 CONTINUE
*
C     CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
*
      NS = N*INCX
        DO 70 I=1,NS,INCX
        STEMP1 = SX(I)
        SX(I) = SY(I)
        SY(I) = STEMP1
   70   CONTINUE
      RETURN
      END
*STRCO
      SUBROUTINE STRCO(T,LDT,N,RCOND,Z,JOB)
C***BEGIN PROLOGUE  STRCO
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D2A3
C***KEYWORDS  CONDITION,FACTOR,LINEAR ALGEBRA,LINPACK,MATRIX,TRIANGULAR
C***AUTHOR  MOLER, C. B., (U. OF NEW MEXICO)
C***PURPOSE  ESTIMATES THE CONDITION OF A REAL TRIANGULAR MATRIX.
C***DESCRIPTION
C     STRCO ESTIMATES THE CONDITION OF A REAL TRIANGULAR MATRIX.
C     ON ENTRY
C        T       REAL(LDT,N)
C                T CONTAINS THE TRIANGULAR MATRIX.  THE ZERO
C                ELEMENTS OF THE MATRIX ARE NOT REFERENCED, AND
C                THE CORRESPONDING ELEMENTS OF THE ARRAY CAN BE
C                USED TO STORE OTHER INFORMATION.
C        LDT     INTEGER
C                LDT IS THE LEADING DIMENSION OF THE ARRAY T.
C        N       INTEGER
C                N IS THE ORDER OF THE SYSTEM.
C        JOB     INTEGER
C                = 0         T  IS LOWER TRIANGULAR.
C                = NONZERO   T  IS UPPER TRIANGULAR.
C     ON RETURN
C        RCOND   REAL
C                AN ESTIMATE OF THE RECIPROCAL CONDITION OF  T .
C                FOR THE SYSTEM  T*X = B , RELATIVE PERTURBATIONS
C                IN  T  AND  B  OF SIZE  EPSILON  MAY CAUSE
C                RELATIVE PERTURBATIONS IN  X  OF SIZE  EPSILON/RCOND .
C                IF  RCOND  IS SO SMALL THAT THE LOGICAL EXPRESSION
C                           1.0 + RCOND .EQ. 1.0
C                IS TRUE, THEN  T  MAY BE SINGULAR TO WORKING
C                PRECISION.  IN PARTICULAR,  RCOND  IS ZERO  IF
C                EXACT SINGULARITY IS DETECTED OR THE ESTIMATE
C                UNDERFLOWS.
C        Z       REAL(N)
C                A WORK VECTOR WHOSE CONTENTS ARE USUALLY UNIMPORTANT.
C                IF  T  IS CLOSE TO A SINGULAR MATRIX, THEN  Z  IS
C                AN APPROXIMATE NULL VECTOR IN THE SENSE THAT
C                NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  SASUM,SAXPY,SSCAL
C***END PROLOGUE  STRCO
*
C...SCALAR ARGUMENTS
      REAL RCOND
      INTEGER
     +   JOB,LDT,N
*
C...ARRAY ARGUMENTS
      REAL T(LDT,*),Z(*)
*
C...LOCAL SCALARS
      REAL EK,S,SM,TNORM,W,WK,WKM,YNORM
      INTEGER
     +   I1,J,J1,J2,K,KK,L
      LOGICAL
     +   LOWER
*
C...EXTERNAL FUNCTIONS
      REAL SASUM
      EXTERNAL
     +   SASUM
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SAXPY,SSCAL
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   ABS,AMAX1,SIGN
*
*
C***FIRST EXECUTABLE STATEMENT  STRCO
*
*
      LOWER = JOB .EQ. 0
*
C     COMPUTE 1-NORM OF T
*
      TNORM = 0.0E0
      DO 10 J = 1, N
         L = J
         IF (LOWER) L = N + 1 - J
         I1 = 1
         IF (LOWER) I1 = J
         TNORM = AMAX1(TNORM,SASUM(L,T(I1,J),1))
   10 CONTINUE
*
C     RCOND = 1/(NORM(T)*(ESTIMATE OF NORM(INVERSE(T)))) .
C     ESTIMATE = NORM(Z)/NORM(Y) WHERE  T*Z = Y  AND  TRANS(T)*Y = E .
C     TRANS(T)  IS THE TRANSPOSE OF T .
C     THE COMPONENTS OF  E  ARE CHOSEN TO CAUSE MAXIMUM LOCAL
C     GROWTH IN THE ELEMENTS OF Y .
C     THE VECTORS ARE FREQUENTLY RESCALED TO AVOID OVERFLOW.
*
C     SOLVE TRANS(T)*Y = E
*
      EK = 1.0E0
      DO 20 J = 1, N
         Z(J) = 0.0E0
   20 CONTINUE
      DO 100 KK = 1, N
         K = KK
         IF (LOWER) K = N + 1 - KK
         IF (Z(K) .NE. 0.0E0) EK = SIGN(EK,-Z(K))
         IF (ABS(EK-Z(K)) .LE. ABS(T(K,K))) GO TO 30
            S = ABS(T(K,K))/ABS(EK-Z(K))
            CALL SSCAL(N,S,Z,1)
            EK = S*EK
   30    CONTINUE
         WK = EK - Z(K)
         WKM = -EK - Z(K)
         S = ABS(WK)
         SM = ABS(WKM)
         IF (T(K,K) .EQ. 0.0E0) GO TO 40
            WK = WK/T(K,K)
            WKM = WKM/T(K,K)
         GO TO 50
   40    CONTINUE
            WK = 1.0E0
            WKM = 1.0E0
   50    CONTINUE
         IF (KK .EQ. N) GO TO 90
            J1 = K + 1
            IF (LOWER) J1 = 1
            J2 = N
            IF (LOWER) J2 = K - 1
            DO 60 J = J1, J2
               SM = SM + ABS(Z(J)+WKM*T(K,J))
               Z(J) = Z(J) + WK*T(K,J)
               S = S + ABS(Z(J))
   60       CONTINUE
            IF (S .GE. SM) GO TO 80
               W = WKM - WK
               WK = WKM
               DO 70 J = J1, J2
                  Z(J) = Z(J) + W*T(K,J)
   70          CONTINUE
   80       CONTINUE
   90    CONTINUE
         Z(K) = WK
  100 CONTINUE
      S = 1.0E0/SASUM(N,Z,1)
      CALL SSCAL(N,S,Z,1)
*
      YNORM = 1.0E0
*
C     SOLVE T*Z = Y
*
      DO 130 KK = 1, N
         K = N + 1 - KK
         IF (LOWER) K = KK
         IF (ABS(Z(K)) .LE. ABS(T(K,K))) GO TO 110
            S = ABS(T(K,K))/ABS(Z(K))
            CALL SSCAL(N,S,Z,1)
            YNORM = S*YNORM
  110    CONTINUE
         IF (T(K,K) .NE. 0.0E0) Z(K) = Z(K)/T(K,K)
         IF (T(K,K) .EQ. 0.0E0) Z(K) = 1.0E0
         I1 = 1
         IF (LOWER) I1 = K + 1
         IF (KK .GE. N) GO TO 120
            W = -Z(K)
            CALL SAXPY(N-KK,W,T(I1,K),1,Z(I1),1)
  120    CONTINUE
  130 CONTINUE
C     MAKE ZNORM = 1.0
      S = 1.0E0/SASUM(N,Z,1)
      CALL SSCAL(N,S,Z,1)
      YNORM = S*YNORM
*
      IF (TNORM .NE. 0.0E0) RCOND = YNORM/TNORM
      IF (TNORM .EQ. 0.0E0) RCOND = 0.0E0
      RETURN
      END
*STRSL
      SUBROUTINE STRSL(T,LDT,N,B,JOB,INFO)
C***BEGIN PROLOGUE  STRSL
C***DATE WRITTEN   780814   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  D2A3
C***KEYWORDS  LINEAR ALGEBRA,LINPACK,MATRIX,SOLVE,TRIANGULAR
C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
C***PURPOSE  SOLVES SYSTEMS OF THE FORM  T*X=B OR TRANS(T)*X=B
C            WHERE T IS A TRIANGULAR MATRIX OF ORDER N.
C***DESCRIPTION
C     STRSL SOLVES SYSTEMS OF THE FORM
C                   T * X = B
C     OR
C                   TRANS(T) * X = B
C     WHERE T IS A TRIANGULAR MATRIX OF ORDER N.  HERE TRANS(T)
C     DENOTES THE TRANSPOSE OF THE MATRIX T.
C     ON ENTRY
C         T         REAL(LDT,N)
C                   T CONTAINS THE MATRIX OF THE SYSTEM.  THE ZERO
C                   ELEMENTS OF THE MATRIX ARE NOT REFERENCED, AND
C                   THE CORRESPONDING ELEMENTS OF THE ARRAY CAN BE
C                   USED TO STORE OTHER INFORMATION.
C         LDT       INTEGER
C                   LDT IS THE LEADING DIMENSION OF THE ARRAY T.
C         N         INTEGER
C                   N IS THE ORDER OF THE SYSTEM.
C         B         REAL(N).
C                   B CONTAINS THE RIGHT HAND SIDE OF THE SYSTEM.
C         JOB       INTEGER
C                   JOB SPECIFIES WHAT KIND OF SYSTEM IS TO BE SOLVED.
C                   IF JOB IS
C                        00   SOLVE T*X=B, T LOWER TRIANGULAR,
C                        01   SOLVE T*X=B, T UPPER TRIANGULAR,
C                        10   SOLVE TRANS(T)*X=B, T LOWER TRIANGULAR,
C                        11   SOLVE TRANS(T)*X=B, T UPPER TRIANGULAR.
C     ON RETURN
C         B         B CONTAINS THE SOLUTION, IF INFO .EQ. 0.
C                   OTHERWISE B IS UNALTERED.
C         INFO      INTEGER
C                   INFO CONTAINS ZERO IF THE SYSTEM IS NONSINGULAR.
C                   OTHERWISE INFO CONTAINS THE INDEX OF
C                   THE FIRST ZERO DIAGONAL ELEMENT OF T.
C     LINPACK.  THIS VERSION DATED 08/14/78 .
C     G. W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
C***ROUTINES CALLED  SAXPY,SDOT
C***END PROLOGUE  STRSL
*
C...SCALAR ARGUMENTS
      INTEGER
     +   INFO,JOB,LDT,N
*
C...ARRAY ARGUMENTS
      REAL B(*),T(LDT,*)
*
C...LOCAL SCALARS
      REAL TEMP
      INTEGER
     +   CASE,J,JJ
*
C...EXTERNAL FUNCTIONS
      REAL SDOT
      EXTERNAL
     +   SDOT
*
C...EXTERNAL SUBROUTINES
      EXTERNAL
     +   SAXPY
*
C...INTRINSIC FUNCTIONS
      INTRINSIC
     +   MOD
*
*
C***FIRST EXECUTABLE STATEMENT  STRSL
*
*
C     BEGIN BLOCK PERMITTING ...EXITS TO 150
*
C        CHECK FOR ZERO DIAGONAL ELEMENTS.
*
         DO 10 INFO = 1, N
C     ......EXIT
            IF (T(INFO,INFO) .EQ. 0.0E0) GO TO 150
   10    CONTINUE
         INFO = 0
*
C        DETERMINE THE TASK AND GO TO IT.
*
         CASE = 1
         IF (MOD(JOB,10) .NE. 0) CASE = 2
         IF (MOD(JOB,100)/10 .NE. 0) CASE = CASE + 2
         GO TO (20,50,80,110), CASE
*
C        SOLVE T*X=B FOR T LOWER TRIANGULAR
*
   20    CONTINUE
            B(1) = B(1)/T(1,1)
            IF (N .LT. 2) GO TO 40
            DO 30 J = 2, N
               TEMP = -B(J-1)
               CALL SAXPY(N-J+1,TEMP,T(J,J-1),1,B(J),1)
               B(J) = B(J)/T(J,J)
   30       CONTINUE
   40       CONTINUE
         GO TO 140
*
C        SOLVE T*X=B FOR T UPPER TRIANGULAR.
*
   50    CONTINUE
            B(N) = B(N)/T(N,N)
            IF (N .LT. 2) GO TO 70
            DO 60 JJ = 2, N
               J = N - JJ + 1
               TEMP = -B(J+1)
               CALL SAXPY(J,TEMP,T(1,J+1),1,B(1),1)
               B(J) = B(J)/T(J,J)
   60       CONTINUE
   70       CONTINUE
         GO TO 140
*
C        SOLVE TRANS(T)*X=B FOR T LOWER TRIANGULAR.
*
   80    CONTINUE
            B(N) = B(N)/T(N,N)
            IF (N .LT. 2) GO TO 100
            DO 90 JJ = 2, N
               J = N - JJ + 1
               B(J) = B(J) - SDOT(JJ-1,T(J+1,J),1,B(J+1),1)
               B(J) = B(J)/T(J,J)
   90       CONTINUE
  100       CONTINUE
         GO TO 140
*
C        SOLVE TRANS(T)*X=B FOR T UPPER TRIANGULAR.
*
  110    CONTINUE
            B(1) = B(1)/T(1,1)
            IF (N .LT. 2) GO TO 130
            DO 120 J = 2, N
               B(J) = B(J) - SDOT(J-1,T(1,J),1,B(1),1)
               B(J) = B(J)/T(J,J)
  120       CONTINUE
  130       CONTINUE
  140    CONTINUE
  150 CONTINUE
      RETURN
      END
*SMPREC
      REAL FUNCTION SMPREC()
C***BEGIN PROLOGUE  SPREC
C***REFER TO  SODR,SODRC
C***ROUTINES CALLED  (NONE)
C***DATE WRITTEN   860529   (YYMMDD)
C***REVISION DATE  890530   (YYMMDD)
C***CATEGORY NO.  G2E,I1B1
C***KEYWORDS  ORTHOGONAL DISTANCE REGRESSION,
C             NONLINEAR LEAST SQUARES,
C             MEASUREMENT ERROR MODELS,
C             ERRORS IN VARIABLES
C***AUTHOR  BOGGS, PAUL T.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             GAITHERSBURG, MD 20899
C           BYRD, RICHARD H.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C           DONALDSON, JANET R.
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C           SCHNABEL, ROBERT B.
C             DEPARTMENT OF COMPUTER SCIENCE
C             UNIVERSITY OF COLORADO
C             BOULDER, CO 80309
C             AND
C             APPLIED AND COMPUTATIONAL MATHEMATICS DIVISION
C             NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C             BOULDER, CO 80303-3328
C***PURPOSE  DETERMINE MACHINE PRECISION FOR TARGET MACHINE AND COMPILER
C            ASSUMING FLOATING-POINT NUMBERS ARE REPRESENTED IN THE
C            T-DIGIT, BASE-B FORM
C                  SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
C            WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, AND
C                  0 .LT. X(1).
C            TO ALTER THIS FUNCTION FOR A PARTICULAR TARGET MACHINE,
C            EITHER
C                  ACTIVATE THE DESIRED SET OF DATA STATEMENTS BY
C                  REMOVING THE C FROM COLUMN 1
C            OR
C                  SET B, TD AND TS USING I1MACH BY ACTIVATING
C                  THE DECLARATION STATEMENTS FOR I1MACH
C                  AND THE STATEMENTS PRECEEDING THE FIRST
C                  EXECUTABLE STATEMENT BELOW.
C***END PROLOGUE  SPREC
*
C...LOCAL SCALARS
      REAL
     +   B
      INTEGER
     +   TD,TS
*
C...EXTERNAL FUNCTIONS
C     INTEGER
C    +   I1MACH
C     EXTERNAL
C    +   I1MACH
*
C...VARIABLE DEFINITIONS (ALPHABETICALLY)
*
C     REAL B
C        THE BASE OF THE TARGET MACHINE.
C        (MAY BE DEFINED USING I1MACH(10).)
C     INTEGER TD
C        THE NUMBER OF BASE-B DIGITS IN DOUBLE PRECISION.
C        (MAY BE DEFINED USING I1MACH(14).)
C     INTEGER TS
C        THE NUMBER OF BASE-B DIGITS IN SINGLE PRECISION.
C        (MAY BE DEFINED USING I1MACH(11).)
*
*
C   MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM.
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  60 /
*
C   MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM
C                         THE BURROUGHS 6700/7700 SYSTEMS
C     DATA B  /   8 /
C     DATA TS /  13 /
C     DATA TD /  26 /
*
C   MACHINE CONSTANTS FOR THE CDC 6000/7000 (FTN5 COMPILER)
C                         THE CYBER 170/180 SERIES UNDER NOS
C     DATA B  /   2 /
C     DATA TS /  48 /
C     DATA TD /  96 /
*
C   MACHINE CONSTANTS FOR THE CDC 6000/7000 (FTN COMPILER)
C                         THE CYBER 170/180 SERIES UNDER NOS/VE
C                         THE CYBER 200 SERIES
C     DATA B  /   2 /
C     DATA TS /  47 /
C     DATA TD /  94 /
*
C   MACHINE CONSTANTS FOR THE CRAY 1
C     DATA B  /   2 /
C     DATA TS /  47 /
C     DATA TD /  94 /
*
C   MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE HARRIS COMPUTER
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  38 /
*
C   MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70
C                         THE HONEYWELL 600/6000 SERIES
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  63 /
*
C   MACHINE CONSTANTS FOR THE HP 2100
C      (3 WORD DOUBLE PRECISION OPTION WITH FTN4)
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  39 /
*
C   MACHINE CONSTANTS FOR THE HP 2100
C      (4 WORD DOUBLE PRECISION OPTION WITH FTN4)
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  55 /
*
C   MACHINE CONSTANTS FOR THE IBM 360/370 SERIES
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE IBM PC
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  53 /
*
C   MACHINE CONSTANTS FOR THE INTERDATA (PERKIN ELMER) 7/32
C                             INTERDATA (PERKIN ELMER) 8/32
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR).
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  54 /
*
C   MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR).
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  62 /
*
C   MACHINE CONSTANTS FOR THE PDP-11 SYSTEM
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  56 /
*
C   MACHINE CONSTANTS FOR THE PERKIN-ELMER 3230
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR THE PRIME 850 AND PRIME 4050
C     DATA B  /   2 /
C     DATA TS /  23 /
C     DATA TD /  47 /
*
C   MACHINE CONSTANTS FOR THE SEL SYSTEMS 85/86
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
C   MACHINE CONSTANTS FOR SUN 3
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  53 /
*
C   MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
C     DATA B  /   2 /
C     DATA TS /  27 /
C     DATA TD /  60 /
*
C   MACHINE CONSTANTS FOR THE VAX-11 WITH FORTRAN IV-PLUS COMPILER
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  56 /
*
C   MACHINE CONSTANTS FOR THE VAX/VMS SYSTEM WITHOUT  G_FLOATING
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  56 /
*
C   MACHINE CONSTANTS FOR THE VAX/VMS SYSTEM WITH G_FLOATING
C     DATA B  /   2 /
C     DATA TS /  24 /
C     DATA TD /  53 /
*
C   MACHINE CONSTANTS FOR THE XEROX SIGMA 5/7/9
C     DATA B  /  16 /
C     DATA TS /   6 /
C     DATA TD /  14 /
*
*
C***FIRST EXECUTABLE STATEMENT  SMPREC
*
*
C     B = I1MACH(10)
C     TS = I1MACH(11)
C     TD = I1MACH(14)
*
      SMPREC = B ** (1-TS)
*
      RETURN
*
      END
