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.1.7
   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  };
   142  ldfjac_, real_8 _p_ xp_, real_8 _p_ fvecp_, int_4 _p_ mode_, real_8 _p_ err_);
   144  delta_, real_8 _p_ x_, real_8 _p_ wa1_, real_8 _p_ wa2_);
   148  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_);
   150  , int_4 _p_ ldfjac_, int_4 _p_ iflag_, real_8 _p_ epsfcn_, real_8 _p_ wa_);
   152  info_, real_8 _p_ wa_, int_4 _p_ lwa_);
   154  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 
   155  _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_, 
   156  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   158  ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, real_8 _p_ wa_, int_4 _p_ lwa_);
   160  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_, 
   161  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_, 
   162  real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   164  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_);
   166  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_ 
   167  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_, 
   168  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   170  , int_4 _p_ info_, int_4 _p_ iwa_, real_8 _p_ wa_, int_4 _p_ lwa_);
   172  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 
   173  _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_, 
   174  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   176  , real_8 _p_ delta_, real_8 _p_ par_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa1_, real_8 _p_ wa2_);
   178  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_);
   180  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_ 
   181  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_, 
   182  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_);
   185  ipvt_, int_4 _p_ lipvt_, real_8 _p_ rdiag_, real_8 _p_ acnorm_, real_8 _p_ wa_);
   187  qtb_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa_);
   190  _p_ w_, logical_4 _p_ sing_);
   192  real_8 _p_ cost_, real_8 _p_ sint_);
   193  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 
   194  _p_ xp_, real_8 _p_ fvecp_, int_4 _p_ mode_, real_8 _p_ err_)
   195  { // ** body not listed **
   266  }
   267  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 
   268  _p_ x_, real_8 _p_ wa1_, real_8 _p_ wa2_)
   269  { // ** body not listed **
   377  }
   378  real_8 _dpmpar (int_4 _p_ i_)
   379  { // ** body not listed **
   400  }
   401  real_8 _enorm (int_4 _p_ n_, real_8 _p_ x_)
   402  { // ** body not listed **
   499  }
   500  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_, 
   501  int_4 _p_ iflag_, int_4 _p_ ml_, int_4 _p_ mu_, real_8 _p_ epsfcn_, real_8 _p_ wa1_, real_8 _p_ wa2_)
   502  { // ** body not listed **
   573  }
   574  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 
   575  _p_ ldfjac_, int_4 _p_ iflag_, real_8 _p_ epsfcn_, real_8 _p_ wa_)
   576  { // ** body not listed **
   612  }
   613  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_, 
   614  real_8 _p_ wa_, int_4 _p_ lwa_)
   615  { // ** body not listed **
   665  }
   666  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_, 
   667  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_ 
   668  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 
   669  _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
   670  { // ** body not listed **
   959  }
   960  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_, 
   961  real_8 _p_ tol_, int_4 _p_ info_, real_8 _p_ wa_, int_4 _p_ lwa_)
   962  { // ** body not listed **
  1008  }
  1009  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_, 
  1010  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 
  1011  _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_ 
  1012  wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  1013  { // ** body not listed **
  1302  }
  1303  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 
  1304  _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_)
  1305  { // ** body not listed **
  1344  }
  1345  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_ 
  1346  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_, 
  1347  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_ 
  1348  qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  1349  { // ** body not listed **
  1630  }
  1631  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 
  1632  _p_ info_, int_4 _p_ iwa_, real_8 _p_ wa_, int_4 _p_ lwa_)
  1633  { // ** body not listed **
  1674  }
  1675  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 
  1676  _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_ 
  1677  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_, 
  1678  real_8 _p_ qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  1679  { // ** body not listed **
  1959  }
  1960  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 
  1961  _p_ delta_, real_8 _p_ par_, real_8 _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa1_, real_8 _p_ wa2_)
  1962  { // ** body not listed **
  2120  }
  2121  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 
  2122  _p_ ldfjac_, real_8 _p_ tol_, int_4 _p_ info_, int_4 _p_ ipvt_, real_8 _p_ wa_, int_4 _p_ lwa_)
  2123  { // ** body not listed **
  2162  }
  2163  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_ 
  2164  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_, 
  2165  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_ 
  2166  qtf_, real_8 _p_ wa1_, real_8 _p_ wa2_, real_8 _p_ wa3_, real_8 _p_ wa4_)
  2167  { // ** body not listed **
  2468  }
  2469  int_4 _qform (int_4 _p_ m_, int_4 _p_ n_, real_8 _p_ q_, int_4 _p_ ldq_, real_8 _p_ wa_)
  2470  { // ** body not listed **
  2536  }
  2537  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 
  2538  _p_ lipvt_, real_8 _p_ rdiag_, real_8 _p_ acnorm_, real_8 _p_ wa_)
  2539  { // ** body not listed **
  2641  }
  2642  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 
  2643  _p_ x_, real_8 _p_ sdiag_, real_8 _p_ wa_)
  2644  { // ** body not listed **
  2753  }
  2754  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_)
  2755  { // ** body not listed **
  2818  }
  2819  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_, 
  2820  logical_4 _p_ sing_)
  2821  { // ** body not listed **
  2951  }
  2952  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_ 
  2953  cost_, real_8 _p_ sint_)
  2954  { // ** body not listed **
  3021  }


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