mathlib-minpack.c

     1  //! @file mathlib-minpack.c
     2  //
     3  //! @section copyright
     4  //
     5  // This file is part of VIF - vintage fortran compiler.
     6  // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
     7  //
     8  //! @section license
     9  //
    10  // This program is free software; you can redistribute it and/or modify it 
    11  // under the terms of the gnu general public license as published by the 
    12  // free software foundation; either version 3 of the license, or 
    13  // (at your option) any later version.
    14  //
    15  // This program is distributed in the hope that it will be useful, but 
    16  // without any warranty; without even the implied warranty of merchantability 
    17  // or fitness for a particular purpose. See the GNU general public license for 
    18  // more details. you should have received a copy of the GNU general public 
    19  // license along with this program. If not, see <http://www.gnu.org/licenses/>.
    20  //
    21  //! @Synopsis
    22  //
    23  //! 23 subprograms from MINPACK
    24  
    25  // Compiled from Fortran source code by VIF.
    26  // Selected subprograms are:
    27  //
    28  // CHKDER ENORM  HYBRD  HYBRJ1 LMDER1 LMDIF1 LMSTR  QFORM  QRSOLV R1UPDT
    29  // DOGLEG FDJAC1 HYBRD1 LMDER  LMDIF  LMPAR  LMSTR1 QRFAC  R1MPYQ RWUPDT
    30  // DPMPAR FDJAC2 HYBRJ
    31  
    32  // Minpack includes software for solving nonlinear equations and
    33  // nonlinear least squares problems.  Five algorithmic paths each include
    34  // a core subroutine and an easy-to-use driver.  The algorithms proceed
    35  // either from an analytic specification of the Jacobian matrix or
    36  // directly from the problem functions.  The paths include facilities for
    37  // systems of equations with a banded Jacobian matrix, for least squares
    38  // problems with a large amount of data, and for checking the consistency
    39  // of the Jacobian matrix with the functions.
    40  // 
    41  // This directory contains the double-precision versions.
    42  // 
    43  // Origonal authors are Jorge More, Burt Garbow, and Ken Hillstrom.
    44  // 
    45  // This version of MINPACK is adapted for VIF.
    46  // Adaptations are trivial, concerning choosing alternative names for
    47  // variable names that coincided with intrinsic functions.
    48  // 
    49  // Source: netlib.org/minpack/
    50  
    51  // The license for MINPACK Fortran source code is:
    52  //
    53  // Minpack Copyright Notice (1999) University of Chicago.  All rights reserved
    54  // 
    55  // Redistribution and use in source and binary forms, with or
    56  // without modification, are permitted provided that the
    57  // following conditions are met:
    58  // 
    59  // 1. Redistributions of source code must retain the above
    60  // copyright notice, this list of conditions and the following
    61  // disclaimer.
    62  // 
    63  // 2. Redistributions in binary form must reproduce the above
    64  // copyright notice, this list of conditions and the following
    65  // disclaimer in the documentation and/or other materials
    66  // provided with the distribution.
    67  // 
    68  // 3. The end-user documentation included with the
    69  // redistribution, if any, must include the following
    70  // acknowledgment:
    71  // 
    72  //    "This product includes software developed by the
    73  //    University of Chicago, as Operator of Argonne National
    74  //    Laboratory.
    75  // 
    76  // Alternately, this acknowledgment may appear in the software
    77  // itself, if and wherever such third-party acknowledgments
    78  // normally appear.
    79  // 
    80  // 4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
    81  // WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
    82  // UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
    83  // THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
    84  // IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
    85  // OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
    86  // OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
    87  // OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
    88  // USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
    89  // THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
    90  // DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
    91  // UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
    92  // BE CORRECTED.
    93  // 
    94  // 5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
    95  // HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
    96  // ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
    97  // INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
    98  // ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
    99  // PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
   100  // SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
   101  // (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
   102  // EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
   103  // POSSIBILITY OF SUCH LOSS OR DAMAGES.
   104  // 
   105  // 
   106  
   107  /*
   108  Generated by VIF - experimental VIntage Fortran compiler.
   109  VIF release 1.2.12
   110  */
   115  static CALLS __calls[__ncalls] = {
   116    {"chkder", 0}, // subroutine
   117    {"dogleg", 0}, // subroutine
   118    {"dpmpar", 0}, // real*8 function
   119    {"enorm", 0}, // real*8 function
   120    {"fdjac1", 0}, // subroutine
   121    {"fdjac2", 0}, // subroutine
   122    {"hybrd1", 0}, // subroutine
   123    {"hybrd", 0}, // subroutine
   124    {"hybrj1", 0}, // subroutine
   125    {"hybrj", 0}, // subroutine
   126    {"lmder1", 0}, // subroutine
   127    {"lmder", 0}, // subroutine
   128    {"lmdif1", 0}, // subroutine
   129    {"lmdif", 0}, // subroutine
   130    {"lmpar", 0}, // subroutine
   131    {"lmstr1", 0}, // subroutine
   132    {"lmstr", 0}, // subroutine
   133    {"qform", 0}, // subroutine
   134    {"qrfac", 0}, // subroutine
   135    {"qrsolv", 0}, // subroutine
   136    {"r1mpyq", 0}, // subroutine
   137    {"r1updt", 0}, // subroutine
   138    {"rwupdt", 0}, // subroutine
   139    {NULL, 0}
   140  };
   141  
   143  ldfjac_, real_8 _p_ xp_, real_8 _p_ fvecp_, int_4 _p_ mode_, real_8 _p_ err_);
   145  delta_, real_8 _p_ x_, real_8 _p_ wa1_, real_8 _p_ wa2_);
   149  ldfjac_, int_4 _p_ iflag_, int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ wa1_, real_8 _p_ wa2_);
   151  , int_4 _p_ ldfjac_, int_4 _p_ iflag_, real_8 _p_ epsfcn_, real_8 _p_ wa_);
   153  info_, real_8 _p_ wa_, int_4 _p_ lwa_);
   155  maxfev_, int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4 
   156  _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, real_8 _p_ r_, int_4 _p_ lr_, 
   157  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   159  ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, real_8 _p_ wa_, int_4 _p_ lwa_);
   161  ldfjac_, real_8 _p_ xtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4 _p_ nprint_, 
   162  int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, real_8 _p_ r_, int_4 _p_ lr_, real_8 _p_ qtf_, real_8 _p_ wa1_, 
   163  real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   165  fjac_, int_4 _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_);
   167  int_4 _p_ ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ 
   168  mode_, real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_, 
   169  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   171  , int_4 _p_ info_, int_4 _p_ iwa_, real_8 _p_ wa_, int_4 _p_ lwa_);
   173  real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 
   174  _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, int_4 _p_ ipvt_, 
   175  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   177  , real_8 _p_ delta_, real_8 _p_ par_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa1_, real_8 _p_ wa2_);
   179  fjac_, int_4 _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_);
   181  int_4 _p_ ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ 
   182  mode_, real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_, 
   183  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   186  ipvt_, int_4 _p_ lipvt_, real_8 _p_ rdiag_, real_8 _p_ acnorm_, real_8 _p_ wa_);
   188  qtb_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa_);
   191  _p_ w_, logical_4 _p_ sing_);
   193  real_8 _p_ cost_, real_8 _p_ sint_);
   194  int_4 _chkder (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, real_8 
   195  _p_ xp_, real_8 _p_ fvecp_, int_4 _p_ mode_, real_8 _p_ err_)
   196  { // ** body not listed **
   267  }
   268  
   269  int_4 _dogleg (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ lr_, real_8 _p_ diag_, real_8 _p_ qtb_, real_8 _p_ delta_, real_8 
   270  _p_ x_, real_8 _p_ wa1_, real_8 _p_ wa2_)
   271  { // ** body not listed **
   379  }
   380  
   381  real_8 _dpmpar (int_4 _p_ i_)
   382  { // ** body not listed **
   403  }
   404  
   405  real_8 _enorm (int_4 _p_ n_, real_8 _p_ x_)
   406  { // ** body not listed **
   503  }
   504  
   505  int_4 _fdjac1 (int_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, 
   506  int_4 _p_ iflag_, int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ wa1_, real_8 _p_ wa2_)
   507  { // ** body not listed **
   578  }
   579  
   580  int_4 _fdjac2 (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 
   581  _p_ ldfjac_, int_4 _p_ iflag_, real_8 _p_ epsfcn_, real_8 _p_ wa_)
   582  { // ** body not listed **
   618  }
   619  
   620  int_4 _hybrd1 (real_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ tol_, int_4 _p_ info_, 
   621  real_8 _p_ wa_, int_4 _p_ lwa_)
   622  { // ** body not listed **
   672  }
   673  
   674  int_4 _hybrd (int_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ xtol_, int_4 _p_ maxfev_, 
   675  int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4 _p_ 
   676  nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, real_8 _p_ r_, int_4 _p_ lr_, real_8 
   677  _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
   678  { // ** body not listed **
   967  }
   968  int_4 _hybrj1 (real_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, 
   969  real_8 _p_ tol_, int_4 _p_ info_, real_8 _p_ wa_, int_4 _p_ lwa_)
   970  { // ** body not listed **
  1016  }
  1017  
  1018  int_4 _hybrj (int_4 (*_fcn)(), int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, 
  1019  real_8 _p_ xtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ factor_, int_4 _p_ nprint_, int_4 
  1020  _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, real_8 _p_ r_, int_4 _p_ lr_, real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ 
  1021  wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  1022  { // ** body not listed **
  1311  }
  1312  int_4 _lmder1 (real_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 
  1313  _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_)
  1314  { // ** body not listed **
  1353  }
  1354  
  1355  int_4 _lmder (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ 
  1356  ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_, 
  1357  real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_, real_8 _p_ 
  1358  qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  1359  { // ** body not listed **
  1640  }
  1641  
  1642  int_4 _lmdif1 (real_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ tol_, int_4 
  1643  _p_ info_, int_4 _p_ iwa_, real_8 _p_ wa_, int_4 _p_ lwa_)
  1644  { // ** body not listed **
  1685  }
  1686  
  1687  int_4 _lmdif (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ ftol_, real_8 
  1688  _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ epsfcn_, real_8 _p_ diag_, int_4 _p_ mode_, real_8 _p_ 
  1689  factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, real_8 _p_ fjac_, int_4 _p_ ldfjac_, int_4 _p_ ipvt_, 
  1690  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  1691  { // ** body not listed **
  1971  }
  1972  
  1973  int_4 _lmpar (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ ldr_, int_4 _p_ ipvt_, real_8 _p_ diag_, real_8 _p_ qtb_, real_8 
  1974  _p_ delta_, real_8 _p_ par_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa1_, real_8 _p_ wa2_)
  1975  { // ** body not listed **
  2133  }
  2134  
  2135  int_4 _lmstr1 (real_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 
  2136  _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_)
  2137  { // ** body not listed **
  2176  }
  2177  
  2178  int_4 _lmstr (int_4 (*_fcn)(), int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ x_, real_8 _p_ fvec_, real_8 _p_ fjac_, int_4 _p_ 
  2179  ldfjac_, real_8 _p_ ftol_, real_8 _p_ xtol_, real_8 _p_ gtol_, int_4 _p_ maxfev_, real_8 _p_ diag_, int_4 _p_ mode_, 
  2180  real_8 _p_ factor_, int_4 _p_ nprint_, int_4 _p_ info_, int_4 _p_ nfev_, int_4 _p_ njev_, int_4 _p_ ipvt_, real_8 _p_ 
  2181  qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  2182  { // ** body not listed **
  2483  }
  2484  
  2485  int_4 _qform (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ q_, int_4 _p_ ldq_, real_8 _p_ wa_)
  2486  { // ** body not listed **
  2552  }
  2553  
  2554  int_4 _qrfac (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ a_, int_4 _p_ lda_, logical_4 _p_ pivot_, int_4 _p_ ipvt_, int_4 
  2555  _p_ lipvt_, real_8 _p_ rdiag_, real_8 _p_ acnorm_, real_8 _p_ wa_)
  2556  { // ** body not listed **
  2658  }
  2659  
  2660  int_4 _qrsolv (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ ldr_, int_4 _p_ ipvt_, real_8 _p_ diag_, real_8 _p_ qtb_, real_8 
  2661  _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa_)
  2662  { // ** body not listed **
  2771  }
  2772  
  2773  int_4 _r1mpyq (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ a_, int_4 _p_ lda_, real_8 _p_ v_, real_8 _p_ w_)
  2774  { // ** body not listed **
  2837  }
  2838  
  2839  int_4 _r1updt (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ s_, int_4 _p_ ls_, real_8 _p_ u_, real_8 _p_ v_, real_8 _p_ w_, 
  2840  logical_4 _p_ sing_)
  2841  { // ** body not listed **
  2971  }
  2972  
  2973  int_4 _rwupdt (int_4 _p_ n_, real_8 _p_ r_, int_4 _p_ ldr_, real_8 _p_ w_, real_8 _p_ b_, real_8 _p_ alpha_, real_8 _p_ 
  2974  cost_, real_8 _p_ sint_)
  2975  { // ** body not listed **
  3042  }
  3043  


© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)