Fixed to compile with modern LAPACK FORTRAN API.

Author: shoops

copasi/lapack/blas.h

@@ -1,4 +1,4 @@
-// Copyright (C) 2019 - 2024 by Pedro Mendes, Rector and Visitors of the
+// Copyright (C) 2019 - 2026 by Pedro Mendes, Rector and Visitors of the
 // University of Virginia, University of Heidelberg, and University
 // of Connecticut School of Medicine.
 // All rights reserved.
@@ -51,8 +51,6 @@ integer idamax_(integer *n, doublereal *dx, integer *incx);
 integer isamax_(integer *n, real *sx, integer *incx);
 /* Function */
 integer izamax_(integer *n, doublecomplex *zx, integer *incx);
-/* Function */
-logical lsame_(char *ca, char *cb);
 
 /* Subroutine */
 int caxpy_(integer *n, complex *ca, complex *cx, integer *incx, complex *cy, integer *incy);

copasi/lapack/f2c.h

@@ -1,4 +1,14 @@
-// Copyright (C) 2013 - 2015 by Pedro Mendes, Virginia Tech Intellectual
+// Copyright (C) 2019 - 2026 by Pedro Mendes, Rector and Visitors of the
+// University of Virginia, University of Heidelberg, and University
+// of Connecticut School of Medicine.
+// All rights reserved.
+
+// Copyright (C) 2017 - 2018 by Pedro Mendes, Virginia Tech Intellectual
+// Properties, Inc., University of Heidelberg, and University of
+// of Connecticut School of Medicine.
+// All rights reserved.
+
+// Copyright (C) 2013 - 2016 by Pedro Mendes, Virginia Tech Intellectual
 // Properties, Inc., University of Heidelberg, and The University
 // of Manchester.
 // All rights reserved.
@@ -170,10 +180,10 @@ struct Namelist
 };
 typedef struct Namelist Namelist;
 
-#define abs(x) ((x) >= 0 ? (x) : -(x))
+// #define abs(x) ((x) >= 0 ? (x) : -(x))
 #define dabs(x) (doublereal)abs(x)
-#define min(a,b) ((a) <= (b) ? (a) : (b))
-#define max(a,b) ((a) >= (b) ? (a) : (b))
+// #define min(a,b) ((a) <= (b) ? (a) : (b))
+// #define max(a,b) ((a) >= (b) ? (a) : (b))
 #define dmin(a,b) (doublereal)min(a,b)
 #define dmax(a,b) (doublereal)max(a,b)
 #define bit_test(a,b) ((a) >> (b) & 1)

copasi/lapack/lapackwrap.h

@@ -1,4 +1,4 @@
-// Copyright (C) 2019 - 2024 by Pedro Mendes, Rector and Visitors of the
+// Copyright (C) 2019 - 2026 by Pedro Mendes, Rector and Visitors of the
 // University of Virginia, University of Heidelberg, and University
 // of Connecticut School of Medicine.
 // All rights reserved.
@@ -30,6 +30,9 @@
 
 extern "C"
 {
+#define COPASI_CPLUSPLUS __cplusplus
+#define HAVE_LAPACK_CONFIG_H
+
 #if (defined HAVE_MKL || (defined WIN32 && defined HAVE_LAPACK_H))
 # define cbdsqr_ CBDSQR
 # define cgbbrd_ CGBBRD
@@ -1261,6 +1264,9 @@ extern "C"
 
 # if defined (HAVE_LAPACK_H) && !defined(HAVE_APPLE)
 #  include <lapack.h>
+#  if defined LAPACK_FORTRAN_STRLEN_END
+#   include "copasi/lapack/name_mangling.h"
+#  endif // LAPACK_FORTRAN_STRLEN_END
 # else
 #  undef small
 #  if defined (HAVE_CLAPACK_H) && !defined(HAVE_APPLE) && !defined(COPASI_OVERWRITE_USE_LAPACK)

copasi/lapack/name_mangling.h

@@ -0,0 +1,23 @@
+// Copyright (C) 2026 by Pedro Mendes, Rector and Visitors of the
+// University of Virginia, University of Heidelberg, and University
+// of Connecticut School of Medicine.
+// All rights reserved.
+
+#pragma once
+
+#define dgees_(...)  LAPACK_dgees(__VA_ARGS__)
+#define dgetrs_(...) LAPACK_dgetrs(__VA_ARGS__)
+#define dgbtrs_(...) LAPACK_dgbtrs(__VA_ARGS__)
+#define dtrtri_(...) LAPACK_dtrtri(__VA_ARGS__)
+#define dlaset_(...) LAPACK_dlaset(__VA_ARGS__)
+#define dpotrf_(...) LAPACK_dpotrf(__VA_ARGS__)
+#define dpotrs_(...) LAPACK_dpotrs(__VA_ARGS__)
+#define dtrexc_(...) LAPACK_dtrexc(__VA_ARGS__)
+#define dtrsyl_(...) LAPACK_dtrsyl(__VA_ARGS__)
+#define dsyev_(...)  LAPACK_dsyev(__VA_ARGS__)
+#define dpotri_(...) LAPACK_dpotri(__VA_ARGS__)
+
+// This is not exposed by lapack.h
+integer dlaic1_(integer *job, integer *j, doublereal *x,
+                doublereal *sest, doublereal *w, doublereal *gamma,
+                doublereal *sestpr, doublereal *s, doublereal *c__);

copasi/odepack++/CRadau5.cpp

@@ -1,4 +1,4 @@
-// Copyright (C) 2019 - 2025 by Pedro Mendes, Rector and Visitors of the
+// Copyright (C) 2019 - 2026 by Pedro Mendes, Rector and Visitors of the
 // University of Virginia, University of Heidelberg, and University
 // of Connecticut School of Medicine.
 // All rights reserved.
@@ -744,8 +744,8 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
       /* Computing MAX */
       /* Computing MIN */
       d__3 = .03, d__4 = pow_dd(&tolst, &c_b54);
-      d__1 = uround * 10 / tolst, d__2 = min(d__3, d__4);
-      fnewt = max(d__1, d__2);
+      d__1 = uround * 10 / tolst, d__2 = std::min(d__3, d__4);
+      fnewt = std::max(d__1, d__2);
     }
   else
     {
@@ -904,7 +904,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
         }
     }
 
-  ldmas2 = max(1, ldmas);
+  ldmas2 = std::max(1, ldmas);
 
   /* ------ HESSENBERG OPTION ONLY FOR EXPLICIT EQU. WITH FULL JACOBIAN */
   if ((implct || jband) && ijob == 7)
@@ -1218,7 +1218,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
   posneg = d_sign(&c_b103, &d__1);
   /* Computing MIN */
   d__2 = abs(*hmax), d__3 = (d__1 = *xend - *x, abs(d__1));
-  hmaxn = min(d__2, d__3);
+  hmaxn = std::min(d__2, d__3);
 
   if (abs(*h__) <= *uround * 10.)
     {
@@ -1227,7 +1227,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
 
   /* Computing MIN */
   d__1 = abs(*h__);
-  *h__ = min(d__1, hmaxn);
+  *h__ = std::min(d__1, hmaxn);
   *h__ = d_sign(h__, &posneg);
   hold = *h__;
   reject = FALSE_;
@@ -1315,7 +1315,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
         {
           /* --- JACOBIAN IS BANDED */
           mujacp = *mujac + 1;
-          md = min(linal_1.mbjac, *m2);
+          md = std::min(linal_1.mbjac, *m2);
           i__1 = *m1 / *m2 + 1;
 
           for (mm = 1; mm <= i__1; ++mm)
@@ -1329,7 +1329,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
                   f1[j] = y[j];
                   /* Computing MAX */
                   d__2 = 1e-5, d__3 = (d__1 = y[j], abs(d__1));
-                  f2[j] = sqrt(*uround * max(d__2, d__3));
+                  f2[j] = sqrt(*uround * std::max(d__2, d__3));
                   y[j] += f2[j];
                   j += md;
 
@@ -1343,11 +1343,11 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
                   j1 = k;
                   /* Computing MAX */
                   i__3 = 1, i__4 = j1 - *mujac;
-                  lbeg = max(i__3, i__4) + *m1;
+                  lbeg = std::max(i__3, i__4) + *m1;
 L14:
                   /* Computing MIN */
                   i__3 = *m2, i__4 = j1 + *mljac;
-                  lend = min(i__3, i__4) + *m1;
+                  lend = std::min(i__3, i__4) + *m1;
                   y[j] = f1[j];
                   mujacj = mujacp - j1 - *m1;
                   i__3 = lend;
@@ -1379,7 +1379,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
               ysafe = y[i__];
               /* Computing MAX */
               d__1 = 1e-5, d__2 = abs(ysafe);
-              delt = sqrt(*uround * max(d__1, d__2));
+              delt = sqrt(*uround * std::max(d__1, d__2));
               y[i__] = ysafe + delt;
               (*fcn)(n, x, &y[1], &cont[1], &rpar[1], &ipar[1]);
               i__2 = *n;
@@ -1508,7 +1508,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
   /*  LOOP FOR THE SIMPLIFIED NEWTON ITERATION */
   /* *** *** *** *** *** *** *** */
   newt = 0;
-  d__1 = max(faccon, *uround);
+  d__1 = std::max(faccon, *uround);
   faccon = pow_dd(&d__1, &c_b113);
   theta = abs(*thet);
 L40:
@@ -1605,8 +1605,8 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
           if (dyth >= 1.)
             {
               /* Computing MAX */
-              d__1 = 1e-4, d__2 = min(20., dyth);
-              qnewt = max(d__1, d__2);
+              d__1 = 1e-4, d__2 = std::min(20., dyth);
+              qnewt = std::max(d__1, d__2);
               d__1 = -1. / (*nit + 4. - 1 - newt);
               hhfac = pow_dd(&qnewt, &d__1) * .8;
               *h__ = hhfac * *h__;
@@ -1627,7 +1627,7 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
         }
     }
 
-  dynold = max(dyno, *uround);
+  dynold = std::max(dyno, *uround);
   i__1 = *n;
 
   for (i__ = 1; i__ <= i__1; ++i__)
@@ -1657,12 +1657,12 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
   /* --- WE REQUIRE .2<=HNEW/H<=8. */
   /* Computing MIN */
   d__1 = *safe, d__2 = cfac / (newt + (*nit << 1));
-  fac = min(d__1, d__2);
+  fac = std::min(d__1, d__2);
   /* Computing MAX */
   /* Computing MIN */
   d__3 = *facl, d__4 = pow_dd(&err, &c_b115) / fac;
-  d__1 = *facr, d__2 = min(d__3, d__4);
-  quot = max(d__1, d__2);
+  d__1 = *facr, d__2 = std::min(d__3, d__4);
+  quot = std::max(d__1, d__2);
   hnew = *h__ / quot;
 
   /* *** *** *** *** *** *** *** */
@@ -1684,14 +1684,14 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
               d__1 = d__2 * d__2 / erracc;
               facgus = hacc / *h__ * pow_dd(&d__1, &c_b115) / *safe;
               /* Computing MAX */
-              d__1 = *facr, d__2 = min(*facl, facgus);
-              facgus = max(d__1, d__2);
-              quot = max(quot, facgus);
+              d__1 = *facr, d__2 = std::min(*facl, facgus);
+              facgus = std::max(d__1, d__2);
+              quot = std::max(quot, facgus);
               hnew = *h__ / quot;
             }
 
           hacc = *h__;
-          erracc = max(.01, err);
+          erracc = std::max(.01, err);
         }
 
       xold = *x;
@@ -1767,15 +1767,15 @@ C_INT CRadau5::operator()(C_INT *n, CRadau5::evalF fcn, double *x, double *
       ++(*nfcn);
       /* Computing MIN */
       d__1 = abs(hnew);
-      hnew = posneg * min(d__1, hmaxn);
+      hnew = posneg * std::min(d__1, hmaxn);
       hopt = hnew;
-      hopt = min(*h__, hnew);
+      hopt = std::min(*h__, hnew);
 
       if (reject)
         {
           /* Computing MIN */
           d__1 = abs(hnew), d__2 = abs(*h__);
-          hnew = posneg * min(d__1, d__2);
+          hnew = posneg * std::min(d__1, d__2);
         }
 
       reject = FALSE_;