add some f2c runtime functions, remove exception, avoid name conflict with libgfortran
This commit is contained in:
Axel Kohlmeyer
@ -10,20 +10,28 @@ fi
|
||||
# cleanup
|
||||
rm -f *.c *.cpp *.P *~ *.orig *.bak *.rej
|
||||
|
||||
# translate files directly, skip those for which we have replacements.
|
||||
# translate original files directly
|
||||
for f in fortran/*.f
|
||||
do \
|
||||
b=$(basename $f .f)
|
||||
# skip files for which we have replacements
|
||||
if test $b == dgetrf2 || test $b == disnan || test $b == dlaisnan || \
|
||||
test $b == dlamch || test $b == dlarft || test $b == dpotrf2 || \
|
||||
test $b == lsame || test $b == xerbla || test $b == zlarft
|
||||
then
|
||||
echo Skipping $b
|
||||
else
|
||||
# convert to C++ with f2c. Make local variables dynamic.
|
||||
f2c -C++ -a -f $f && mv $b.c $b.cpp || exit 2
|
||||
# silence c++ compiler warnings about string constants
|
||||
sed -i -e 's/\("[^"]\+"\)/(char *)\1/g' -e 's/^extern.*"C"/extern "C"/' \
|
||||
-e 's/^#include.*"f2c.h"/#include "lmp_f2c.h"/' $b.cpp
|
||||
# replace libf2c functions with local versions under a different name
|
||||
sed -i -e 's/s_\(cat\|cmp\|copy\)(/s_lmp_\1(/g' \
|
||||
-e 's/d_\(sign\|cnjg\|imag\|lg10\)(/d_lmp_\1(/g' \
|
||||
-e 's/z_\(abs\|div\)(/z_lmp_\1(/g' \
|
||||
-e 's/i_\(len\|nint\|dnnt\)(/i_lmp_\1(/g' \
|
||||
-e 's/pow_\(dd\|di\|ii\)(/pow_lmp_\1(/g' $b.cpp
|
||||
fi
|
||||
done
|
||||
|
||||
@ -31,10 +39,17 @@ done
|
||||
for f in static/*.f
|
||||
do \
|
||||
b=$(basename $f .f)
|
||||
# convert to C++ with f2c. Make local variables dynamic.
|
||||
f2c -C++ -a -f $f && mv $b.c $b.cpp || exit 2
|
||||
# silence c++ compiler warnings about string constants
|
||||
sed -i -e 's/\("[^"]\+"\)/(char *)\1/g' -e 's/^extern.*"C"/extern "C"/' \
|
||||
-e 's/^#include.*"f2c.h"/#include "lmp_f2c.h"/' $b.cpp
|
||||
# replace libf2c functions with local versions under a different name
|
||||
sed -i -e 's/s_\(cat\|cmp\|copy\)(/s_lmp_\1(/g' \
|
||||
-e 's/d_\(sign\|cnjg\|imag\|lg10\)(/d_lmp_\1(/g' \
|
||||
-e 's/z_\(abs\|div\)(/z_lmp_\1(/g' \
|
||||
-e 's/i_\(len\|nint\|dnnt\)(/i_lmp_\1(/g' \
|
||||
-e 's/pow_\(dd\|di\|ii\)(/pow_lmp_\1(/g' $b.cpp
|
||||
done
|
||||
|
||||
# copy direct C++ alternatives
|
||||
@ -42,3 +57,6 @@ for c in static/*.cpp
|
||||
do \
|
||||
cp -v $c .
|
||||
done
|
||||
|
||||
# fix whitespace
|
||||
python ../../tools/coding_standard/whitespace.py -c whitespace.conf -f .
|
||||
|
||||
13
lib/linalg/d_lmp_cnjg.cpp
Normal file
13
lib/linalg/d_lmp_cnjg.cpp
Normal file
@ -0,0 +1,13 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
void d_lmp_cnjg(doublecomplex *r, doublecomplex *z)
|
||||
{
|
||||
doublereal zi = z->i;
|
||||
|
||||
r->r = z->r;
|
||||
r->i = -zi;
|
||||
}
|
||||
}
|
||||
10
lib/linalg/d_lmp_imag.cpp
Normal file
10
lib/linalg/d_lmp_imag.cpp
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
double d_lmp_imag(doublecomplex *z)
|
||||
{
|
||||
return (z->i);
|
||||
}
|
||||
}
|
||||
14
lib/linalg/d_lmp_lg10.cpp
Normal file
14
lib/linalg/d_lmp_lg10.cpp
Normal file
@ -0,0 +1,14 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
static constexpr double log10e = 0.43429448190325182765;
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
double d_lmp_lg10(doublereal *x)
|
||||
{
|
||||
return (log10e * log(*x));
|
||||
}
|
||||
}
|
||||
12
lib/linalg/d_lmp_sign.cpp
Normal file
12
lib/linalg/d_lmp_sign.cpp
Normal file
@ -0,0 +1,12 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
double d_lmp_sign(doublereal *a, doublereal *b)
|
||||
{
|
||||
double x;
|
||||
x = (*a >= 0 ? *a : -*a);
|
||||
return (*b >= 0 ? x : -x);
|
||||
}
|
||||
}
|
||||
@ -274,7 +274,7 @@ f"> */
|
||||
doublereal d__1, d__2, d__3, d__4;
|
||||
|
||||
/* Builtin functions */
|
||||
double pow_dd(doublereal *, doublereal *), sqrt(doublereal), d_sign(
|
||||
double pow_lmp_dd(doublereal *, doublereal *), sqrt(doublereal), d_lmp_sign(
|
||||
doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
@ -454,7 +454,7 @@ f"> */
|
||||
|
||||
/* Computing MAX */
|
||||
/* Computing MIN */
|
||||
d__3 = 100., d__4 = pow_dd(&eps, &c_b15);
|
||||
d__3 = 100., d__4 = pow_lmp_dd(&eps, &c_b15);
|
||||
d__1 = 10., d__2 = min(d__3,d__4);
|
||||
tolmul = max(d__1,d__2);
|
||||
tol = tolmul * eps;
|
||||
@ -852,7 +852,7 @@ L90:
|
||||
/* Chase bulge from top to bottom */
|
||||
/* Save cosines and sines for later singular vector updates */
|
||||
|
||||
f = ((d__1 = d__[ll], abs(d__1)) - shift) * (d_sign(&c_b49, &d__[
|
||||
f = ((d__1 = d__[ll], abs(d__1)) - shift) * (d_lmp_sign(&c_b49, &d__[
|
||||
ll]) + shift / d__[ll]);
|
||||
g = e[ll];
|
||||
i__1 = m - 1;
|
||||
@ -912,7 +912,7 @@ L90:
|
||||
/* Chase bulge from bottom to top */
|
||||
/* Save cosines and sines for later singular vector updates */
|
||||
|
||||
f = ((d__1 = d__[m], abs(d__1)) - shift) * (d_sign(&c_b49, &d__[m]
|
||||
f = ((d__1 = d__[m], abs(d__1)) - shift) * (d_lmp_sign(&c_b49, &d__[m]
|
||||
) + shift / d__[m]);
|
||||
g = e[m - 1];
|
||||
i__1 = ll + 1;
|
||||
|
||||
@ -66,7 +66,7 @@ doublereal dcabs1_(doublecomplex *z__)
|
||||
doublereal ret_val, d__1, d__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_imag(doublecomplex *);
|
||||
double d_lmp_imag(doublecomplex *);
|
||||
|
||||
|
||||
/* -- Reference BLAS level1 routine -- */
|
||||
@ -80,7 +80,7 @@ doublereal dcabs1_(doublecomplex *z__)
|
||||
|
||||
/* .. Intrinsic Functions .. */
|
||||
|
||||
ret_val = (d__1 = z__->r, abs(d__1)) + (d__2 = d_imag(z__), abs(d__2));
|
||||
ret_val = (d__1 = z__->r, abs(d__1)) + (d__2 = d_lmp_imag(z__), abs(d__2));
|
||||
return ret_val;
|
||||
|
||||
/* End of DCABS1 */
|
||||
|
||||
@ -248,7 +248,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
double sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
@ -391,7 +391,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = jobu;
|
||||
i__1[1] = 1, a__1[1] = jobvt;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
mnthr = ilaenv_(&c__6, (char *)"DGESVD", ch__1, m, n, &c__0, &c__0, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
bdspac = *n * 5;
|
||||
@ -650,7 +650,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = jobu;
|
||||
i__1[1] = 1, a__1[1] = jobvt;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
mnthr = ilaenv_(&c__6, (char *)"DGESVD", ch__1, m, n, &c__0, &c__0, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
bdspac = *m * 5;
|
||||
|
||||
@ -93,7 +93,7 @@ f"> */
|
||||
/* Subroutine */ int dlabad_(doublereal *small, doublereal *large)
|
||||
{
|
||||
/* Builtin functions */
|
||||
double d_lg10(doublereal *), sqrt(doublereal);
|
||||
double d_lmp_lg10(doublereal *), sqrt(doublereal);
|
||||
|
||||
|
||||
/* -- LAPACK auxiliary routine -- */
|
||||
@ -112,7 +112,7 @@ f"> */
|
||||
/* If it looks like we're on a Cray, take the square root of */
|
||||
/* SMALL and LARGE to avoid overflow and underflow problems. */
|
||||
|
||||
if (d_lg10(large) > 2e3) {
|
||||
if (d_lmp_lg10(large) > 2e3) {
|
||||
*small = sqrt(*small);
|
||||
*large = sqrt(*large);
|
||||
}
|
||||
|
||||
@ -165,7 +165,7 @@ f"> */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
integer i_dnnt(doublereal *);
|
||||
integer i_lmp_dnnt(doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__;
|
||||
@ -246,7 +246,7 @@ L20:
|
||||
} else {
|
||||
x[i__] = -1.;
|
||||
}
|
||||
isgn[i__] = i_dnnt(&x[i__]);
|
||||
isgn[i__] = i_lmp_dnnt(&x[i__]);
|
||||
/* L30: */
|
||||
}
|
||||
*kase = 2;
|
||||
@ -287,7 +287,7 @@ L70:
|
||||
} else {
|
||||
xs = -1.;
|
||||
}
|
||||
if (i_dnnt(&xs) != isgn[i__]) {
|
||||
if (i_lmp_dnnt(&xs) != isgn[i__]) {
|
||||
goto L90;
|
||||
}
|
||||
/* L80: */
|
||||
@ -308,7 +308,7 @@ L90:
|
||||
} else {
|
||||
x[i__] = -1.;
|
||||
}
|
||||
isgn[i__] = i_dnnt(&x[i__]);
|
||||
isgn[i__] = i_lmp_dnnt(&x[i__]);
|
||||
/* L100: */
|
||||
}
|
||||
*kase = 2;
|
||||
|
||||
@ -208,7 +208,7 @@ f"> */
|
||||
|
||||
/* Builtin functions */
|
||||
double log(doublereal);
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, k, iq, lgn, msd2, smm1, spm1, spm2;
|
||||
@ -354,10 +354,10 @@ L10:
|
||||
|
||||
temp = log((doublereal) (*n)) / log(2.);
|
||||
lgn = (integer) temp;
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
iprmpt = indxq + *n + 1;
|
||||
|
||||
@ -217,7 +217,7 @@ f"> */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, n2, n12, ii, n23, iq2;
|
||||
@ -374,7 +374,7 @@ f"> */
|
||||
i__1 = *k;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
d__1 = sqrt(-w[i__]);
|
||||
w[i__] = d_sign(&d__1, &s[i__]);
|
||||
w[i__] = d_lmp_sign(&d__1, &s[i__]);
|
||||
/* L70: */
|
||||
}
|
||||
|
||||
|
||||
@ -165,7 +165,7 @@ f"> */
|
||||
doublereal d__1, d__2, d__3, d__4;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), log(doublereal), pow_di(doublereal *, integer *);
|
||||
double sqrt(doublereal), log(doublereal), pow_lmp_di(doublereal *, integer *);
|
||||
|
||||
/* Local variables */
|
||||
doublereal a, b, c__, f;
|
||||
@ -281,7 +281,7 @@ f"> */
|
||||
eps = dlamch_((char *)"Epsilon", (ftnlen)7);
|
||||
base = dlamch_((char *)"Base", (ftnlen)4);
|
||||
i__1 = (integer) (log(dlamch_((char *)"SafMin", (ftnlen)6)) / log(base) / 3.);
|
||||
small1 = pow_di(&base, &i__1);
|
||||
small1 = pow_lmp_di(&base, &i__1);
|
||||
sminv1 = 1. / small1;
|
||||
small2 = small1 * small1;
|
||||
sminv2 = sminv1 * sminv1;
|
||||
|
||||
@ -293,7 +293,7 @@ f"> */
|
||||
integer q_dim1, q_offset, i__1, i__2;
|
||||
|
||||
/* Builtin functions */
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, k, n1, n2, is, iw, iz, iq2, ptr, ldq2, indx, curr;
|
||||
@ -408,11 +408,11 @@ f"> */
|
||||
/* Form the z-vector which consists of the last row of Q_1 and the */
|
||||
/* first row of Q_2. */
|
||||
|
||||
ptr = pow_ii(&c__2, tlvls) + 1;
|
||||
ptr = pow_lmp_ii(&c__2, tlvls) + 1;
|
||||
i__1 = *curlvl - 1;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
i__2 = *tlvls - i__;
|
||||
ptr += pow_ii(&c__2, &i__2);
|
||||
ptr += pow_lmp_ii(&c__2, &i__2);
|
||||
/* L10: */
|
||||
}
|
||||
curr = ptr + *curpbm;
|
||||
|
||||
@ -186,7 +186,7 @@ f"> */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j;
|
||||
@ -336,7 +336,7 @@ f"> */
|
||||
i__1 = *k;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
d__1 = sqrt(-w[i__]);
|
||||
w[i__] = d_sign(&d__1, &s[i__ + s_dim1]);
|
||||
w[i__] = d_lmp_sign(&d__1, &s[i__ + s_dim1]);
|
||||
/* L80: */
|
||||
}
|
||||
|
||||
|
||||
@ -198,7 +198,7 @@ f"> */
|
||||
integer i__1, i__2, i__3;
|
||||
|
||||
/* Builtin functions */
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
double sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
@ -277,7 +277,7 @@ f"> */
|
||||
/* scheme */
|
||||
|
||||
i__1 = *curlvl - 1;
|
||||
curr = ptr + *curpbm * pow_ii(&c__2, curlvl) + pow_ii(&c__2, &i__1) - 1;
|
||||
curr = ptr + *curpbm * pow_lmp_ii(&c__2, curlvl) + pow_lmp_ii(&c__2, &i__1) - 1;
|
||||
|
||||
/* Determine size of these matrices. We add HALF to the value of */
|
||||
/* the SQRT in case the machine underestimates one of these square */
|
||||
@ -304,12 +304,12 @@ f"> */
|
||||
/* rotations and permutation and then multiplying the center matrices */
|
||||
/* against the current Z. */
|
||||
|
||||
ptr = pow_ii(&c__2, tlvls) + 1;
|
||||
ptr = pow_lmp_ii(&c__2, tlvls) + 1;
|
||||
i__1 = *curlvl - 1;
|
||||
for (k = 1; k <= i__1; ++k) {
|
||||
i__2 = *curlvl - k;
|
||||
i__3 = *curlvl - k - 1;
|
||||
curr = ptr + *curpbm * pow_ii(&c__2, &i__2) + pow_ii(&c__2, &i__3) -
|
||||
curr = ptr + *curpbm * pow_lmp_ii(&c__2, &i__2) + pow_lmp_ii(&c__2, &i__3) -
|
||||
1;
|
||||
psiz1 = prmptr[curr + 1] - prmptr[curr];
|
||||
psiz2 = prmptr[curr + 2] - prmptr[curr + 1];
|
||||
@ -371,7 +371,7 @@ f"> */
|
||||
c__1);
|
||||
|
||||
i__2 = *tlvls - k;
|
||||
ptr += pow_ii(&c__2, &i__2);
|
||||
ptr += pow_lmp_ii(&c__2, &i__2);
|
||||
/* L70: */
|
||||
}
|
||||
|
||||
|
||||
@ -302,7 +302,7 @@ f"> */
|
||||
i__2;
|
||||
|
||||
/* Builtin functions */
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, i1, ic, lf, nd, ll, nl, nr, im1, nlf, nrf, lvl, ndb1,
|
||||
@ -469,7 +469,7 @@ f"> */
|
||||
/* Finally go through the left singular vector matrices of all */
|
||||
/* the other subproblems bottom-up on the tree. */
|
||||
|
||||
j = pow_ii(&c__2, &nlvl);
|
||||
j = pow_lmp_ii(&c__2, &nlvl);
|
||||
sqre = 0;
|
||||
|
||||
for (lvl = nlvl; lvl >= 1; --lvl) {
|
||||
@ -483,7 +483,7 @@ f"> */
|
||||
ll = 1;
|
||||
} else {
|
||||
i__1 = lvl - 1;
|
||||
lf = pow_ii(&c__2, &i__1);
|
||||
lf = pow_lmp_ii(&c__2, &i__1);
|
||||
ll = (lf << 1) - 1;
|
||||
}
|
||||
i__1 = ll;
|
||||
@ -528,7 +528,7 @@ L50:
|
||||
ll = 1;
|
||||
} else {
|
||||
i__2 = lvl - 1;
|
||||
lf = pow_ii(&c__2, &i__2);
|
||||
lf = pow_lmp_ii(&c__2, &i__2);
|
||||
ll = (lf << 1) - 1;
|
||||
}
|
||||
i__2 = lf;
|
||||
|
||||
@ -211,7 +211,7 @@ f"> */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double log(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double log(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
integer c__, i__, j, k;
|
||||
@ -470,7 +470,7 @@ f"> */
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
if ((d__1 = d__[i__], abs(d__1)) < eps) {
|
||||
d__[i__] = d_sign(&eps, &d__[i__]);
|
||||
d__[i__] = d_lmp_sign(&eps, &d__[i__]);
|
||||
}
|
||||
/* L50: */
|
||||
}
|
||||
|
||||
68
lib/linalg/dlamc3.cpp
Normal file
68
lib/linalg/dlamc3.cpp
Normal file
@ -0,0 +1,68 @@
|
||||
/* static/dlamc3.f -- translated by f2c (version 20200916).
|
||||
You must link the resulting object file with libf2c:
|
||||
on Microsoft Windows system, link with libf2c.lib;
|
||||
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
||||
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
||||
-- in that order, at the end of the command line, as in
|
||||
cc *.o -lf2c -lm
|
||||
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
||||
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
*/
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
/* > \brief \b DLAMC3 */
|
||||
/* > \details */
|
||||
/* > \b Purpose: */
|
||||
/* > \verbatim */
|
||||
/* > DLAMC3 is intended to force A and B to be stored prior to doing */
|
||||
/* > the addition of A and B , for use in situations where optimizers */
|
||||
/* > might hold one of these in a register. */
|
||||
/* > \endverbatim */
|
||||
/* > \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ.
|
||||
of Colorado Denver and NAG Ltd.. */
|
||||
/* > \date December 2016 */
|
||||
/* > \ingroup auxOTHERauxiliary */
|
||||
/* > */
|
||||
/* > \param[in] A */
|
||||
/* > \verbatim */
|
||||
/* > A is a DOUBLE PRECISION */
|
||||
/* > \endverbatim */
|
||||
/* > */
|
||||
/* > \param[in] B */
|
||||
/* > \verbatim */
|
||||
/* > B is a DOUBLE PRECISION */
|
||||
/* > The values A and B. */
|
||||
/* > \endverbatim */
|
||||
/* > */
|
||||
doublereal dlamc3_(doublereal *a, doublereal *b)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal ret_val;
|
||||
|
||||
|
||||
/* -- LAPACK auxiliary routine (version 3.7.0) -- */
|
||||
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
|
||||
/* November 2010 */
|
||||
|
||||
/* .. Scalar Arguments .. */
|
||||
/* .. */
|
||||
/* ===================================================================== */
|
||||
|
||||
/* .. Executable Statements .. */
|
||||
|
||||
ret_val = *a + *b;
|
||||
|
||||
return ret_val;
|
||||
|
||||
/* End of DLAMC3 */
|
||||
|
||||
} /* dlamc3_ */
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
@ -130,7 +130,7 @@ f"> */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_sign(doublereal *, doublereal *);
|
||||
double d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
integer j, knt;
|
||||
@ -189,7 +189,7 @@ f"> */
|
||||
/* general case */
|
||||
|
||||
d__1 = dlapy2_(alpha, &xnorm);
|
||||
beta = -d_sign(&d__1, alpha);
|
||||
beta = -d_lmp_sign(&d__1, alpha);
|
||||
safmin = dlamch_((char *)"S", (ftnlen)1) / dlamch_((char *)"E", (ftnlen)1);
|
||||
knt = 0;
|
||||
if (abs(beta) < safmin) {
|
||||
@ -212,7 +212,7 @@ L10:
|
||||
i__1 = *n - 1;
|
||||
xnorm = dnrm2_(&i__1, &x[1], incx);
|
||||
d__1 = dlapy2_(alpha, &xnorm);
|
||||
beta = -d_sign(&d__1, alpha);
|
||||
beta = -d_lmp_sign(&d__1, alpha);
|
||||
}
|
||||
*tau = (beta - *alpha) / beta;
|
||||
i__1 = *n - 1;
|
||||
|
||||
@ -123,7 +123,7 @@ f"> */
|
||||
doublereal d__1, d__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double log(doublereal), pow_di(doublereal *, integer *), sqrt(doublereal);
|
||||
double log(doublereal), pow_lmp_di(doublereal *, integer *), sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
integer i__;
|
||||
@ -166,7 +166,7 @@ f"> */
|
||||
eps = dlamch_((char *)"E", (ftnlen)1);
|
||||
d__1 = dlamch_((char *)"B", (ftnlen)1);
|
||||
i__1 = (integer) (log(safmin / eps) / log(dlamch_((char *)"B", (ftnlen)1)) / 2.);
|
||||
safmn2 = pow_di(&d__1, &i__1);
|
||||
safmn2 = pow_lmp_di(&d__1, &i__1);
|
||||
safmx2 = 1. / safmn2;
|
||||
/* FIRST = .FALSE. */
|
||||
/* END IF */
|
||||
|
||||
@ -198,7 +198,7 @@ f"> */
|
||||
doublereal d__1, d__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j;
|
||||
@ -368,7 +368,7 @@ f"> */
|
||||
i__1 = *k;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
d__2 = sqrt((d__1 = work[iwk3i + i__], abs(d__1)));
|
||||
z__[i__] = d_sign(&d__2, &z__[i__]);
|
||||
z__[i__] = d_lmp_sign(&d__2, &z__[i__]);
|
||||
/* L50: */
|
||||
}
|
||||
|
||||
|
||||
@ -310,7 +310,7 @@ f"> */
|
||||
z_dim1, z_offset, i__1, i__2;
|
||||
|
||||
/* Builtin functions */
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc, nlf, nrf,
|
||||
@ -553,7 +553,7 @@ f"> */
|
||||
|
||||
/* Now conquer each subproblem bottom-up. */
|
||||
|
||||
j = pow_ii(&c__2, &nlvl);
|
||||
j = pow_lmp_ii(&c__2, &nlvl);
|
||||
for (lvl = nlvl; lvl >= 1; --lvl) {
|
||||
lvl2 = (lvl << 1) - 1;
|
||||
|
||||
@ -565,7 +565,7 @@ f"> */
|
||||
ll = 1;
|
||||
} else {
|
||||
i__1 = lvl - 1;
|
||||
lf = pow_ii(&c__2, &i__1);
|
||||
lf = pow_lmp_ii(&c__2, &i__1);
|
||||
ll = (lf << 1) - 1;
|
||||
}
|
||||
i__1 = ll;
|
||||
|
||||
@ -167,7 +167,7 @@ f"> */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
doublereal a, d__, l, m, r__, s, t, fa, ga, ha, ft, gt, ht, mm, tt, clt,
|
||||
@ -305,9 +305,9 @@ f"> */
|
||||
/* Note that M is very tiny */
|
||||
|
||||
if (l == 0.) {
|
||||
t = d_sign(&c_b3, &ft) * d_sign(&c_b4, >);
|
||||
t = d_lmp_sign(&c_b3, &ft) * d_lmp_sign(&c_b4, >);
|
||||
} else {
|
||||
t = gt / d_sign(&d__, &ft) + m / t;
|
||||
t = gt / d_lmp_sign(&d__, &ft) + m / t;
|
||||
}
|
||||
} else {
|
||||
t = (m / (s + t) + m / (r__ + l)) * (a + 1.);
|
||||
@ -334,17 +334,17 @@ f"> */
|
||||
/* Correct signs of SSMAX and SSMIN */
|
||||
|
||||
if (pmax == 1) {
|
||||
tsign = d_sign(&c_b4, csr) * d_sign(&c_b4, csl) * d_sign(&c_b4, f);
|
||||
tsign = d_lmp_sign(&c_b4, csr) * d_lmp_sign(&c_b4, csl) * d_lmp_sign(&c_b4, f);
|
||||
}
|
||||
if (pmax == 2) {
|
||||
tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, csl) * d_sign(&c_b4, g);
|
||||
tsign = d_lmp_sign(&c_b4, snr) * d_lmp_sign(&c_b4, csl) * d_lmp_sign(&c_b4, g);
|
||||
}
|
||||
if (pmax == 3) {
|
||||
tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, snl) * d_sign(&c_b4, h__);
|
||||
tsign = d_lmp_sign(&c_b4, snr) * d_lmp_sign(&c_b4, snl) * d_lmp_sign(&c_b4, h__);
|
||||
}
|
||||
*ssmax = d_sign(ssmax, &tsign);
|
||||
d__1 = tsign * d_sign(&c_b4, f) * d_sign(&c_b4, h__);
|
||||
*ssmin = d_sign(ssmin, &d__1);
|
||||
*ssmax = d_lmp_sign(ssmax, &tsign);
|
||||
d__1 = tsign * d_lmp_sign(&c_b4, f) * d_lmp_sign(&c_b4, h__);
|
||||
*ssmin = d_lmp_sign(ssmin, &d__1);
|
||||
return 0;
|
||||
|
||||
/* End of DLASV2 */
|
||||
|
||||
@ -227,7 +227,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i1, i2, nb, mi, ni, nq, nw;
|
||||
@ -329,7 +329,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = *m - 1;
|
||||
i__2 = *m - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, &i__1, n, &i__2, &c_n1, (
|
||||
@ -338,7 +338,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = *n - 1;
|
||||
i__2 = *n - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, m, &i__1, &i__2, &c_n1, (
|
||||
@ -349,7 +349,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = *m - 1;
|
||||
i__2 = *m - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMLQ", ch__1, &i__1, n, &i__2, &c_n1, (
|
||||
@ -358,7 +358,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = *n - 1;
|
||||
i__2 = *n - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMLQ", ch__1, m, &i__1, &i__2, &c_n1, (
|
||||
|
||||
@ -201,7 +201,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iwt;
|
||||
@ -302,7 +302,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"DORMLQ", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nb = min(i__1,i__2);
|
||||
@ -334,7 +334,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 2, i__2 = ilaenv_(&c__2, (char *)"DORMLQ", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nbmin = max(i__1,i__2);
|
||||
|
||||
@ -201,7 +201,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, i1, i2, i3, ib, nb, mi, ni, nq, nw, iwt;
|
||||
@ -303,7 +303,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"DORMQL", ch__1, m, n, k, &c_n1,
|
||||
(ftnlen)6, (ftnlen)2);
|
||||
nb = min(i__1,i__2);
|
||||
@ -335,7 +335,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 2, i__2 = ilaenv_(&c__2, (char *)"DORMQL", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nbmin = max(i__1,i__2);
|
||||
|
||||
@ -201,7 +201,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iwt;
|
||||
@ -300,7 +300,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"DORMQR", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nb = min(i__1,i__2);
|
||||
@ -332,7 +332,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 2, i__2 = ilaenv_(&c__2, (char *)"DORMQR", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nbmin = max(i__1,i__2);
|
||||
|
||||
@ -203,7 +203,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i1, i2, nb, mi, ni, nq, nw;
|
||||
@ -297,7 +297,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *m - 1;
|
||||
i__3 = *m - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMQL", ch__1, &i__2, n, &i__3, &c_n1, (
|
||||
@ -306,7 +306,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *n - 1;
|
||||
i__3 = *n - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMQL", ch__1, m, &i__2, &i__3, &c_n1, (
|
||||
@ -317,7 +317,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *m - 1;
|
||||
i__3 = *m - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, &i__2, n, &i__3, &c_n1, (
|
||||
@ -326,7 +326,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *n - 1;
|
||||
i__3 = *n - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, m, &i__2, &i__3, &c_n1, (
|
||||
|
||||
@ -223,7 +223,7 @@ f"> */
|
||||
|
||||
/* Builtin functions */
|
||||
double log(doublereal);
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
double sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
@ -336,10 +336,10 @@ f"> */
|
||||
lwmin = *n - 1 << 1;
|
||||
} else {
|
||||
lgn = (integer) (log((doublereal) (*n)) / log(2.));
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
if (icompz == 1) {
|
||||
|
||||
@ -164,7 +164,7 @@ f"> */
|
||||
doublereal d__1, d__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
doublereal b, c__, f, g;
|
||||
@ -441,7 +441,7 @@ L60:
|
||||
|
||||
g = (d__[l + 1] - p) / (e[l] * 2.);
|
||||
r__ = dlapy2_(&g, &c_b10);
|
||||
g = d__[m] - p + e[l] / (g + d_sign(&r__, &g));
|
||||
g = d__[m] - p + e[l] / (g + d_lmp_sign(&r__, &g));
|
||||
|
||||
s = 1.;
|
||||
c__ = 1.;
|
||||
@ -564,7 +564,7 @@ L110:
|
||||
|
||||
g = (d__[l - 1] - p) / (e[l - 1] * 2.);
|
||||
r__ = dlapy2_(&g, &c_b10);
|
||||
g = d__[m] - p + e[l - 1] / (g + d_sign(&r__, &g));
|
||||
g = d__[m] - p + e[l - 1] / (g + d_lmp_sign(&r__, &g));
|
||||
|
||||
s = 1.;
|
||||
c__ = 1.;
|
||||
|
||||
@ -116,7 +116,7 @@ f"> */
|
||||
doublereal d__1, d__2, d__3;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
doublereal c__;
|
||||
@ -342,7 +342,7 @@ L70:
|
||||
rte = sqrt(e[l]);
|
||||
sigma = (d__[l + 1] - p) / (rte * 2.);
|
||||
r__ = dlapy2_(&sigma, &c_b33);
|
||||
sigma = p - rte / (sigma + d_sign(&r__, &sigma));
|
||||
sigma = p - rte / (sigma + d_lmp_sign(&r__, &sigma));
|
||||
|
||||
c__ = 1.;
|
||||
s = 0.;
|
||||
@ -440,7 +440,7 @@ L120:
|
||||
rte = sqrt(e[l - 1]);
|
||||
sigma = (d__[l - 1] - p) / (rte * 2.);
|
||||
r__ = dlapy2_(&sigma, &c_b33);
|
||||
sigma = p - rte / (sigma + d_sign(&r__, &sigma));
|
||||
sigma = p - rte / (sigma + d_lmp_sign(&r__, &sigma));
|
||||
|
||||
c__ = 1.;
|
||||
s = 0.;
|
||||
|
||||
@ -142,7 +142,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer j, jb, nb, nn;
|
||||
@ -235,7 +235,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__2[0] = 1, a__1[0] = uplo;
|
||||
i__2[1] = 1, a__1[1] = diag;
|
||||
s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2);
|
||||
nb = ilaenv_(&c__1, (char *)"DTRTRI", ch__1, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (
|
||||
ftnlen)2);
|
||||
if (nb <= 1 || nb >= *n) {
|
||||
|
||||
@ -97,7 +97,7 @@ doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)
|
||||
doublereal ret_val, d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_imag(doublecomplex *), sqrt(doublereal);
|
||||
double d_lmp_imag(doublecomplex *), sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
integer ix;
|
||||
@ -153,8 +153,8 @@ doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)
|
||||
ssq += d__1 * d__1;
|
||||
}
|
||||
}
|
||||
if (d_imag(&x[ix]) != 0.) {
|
||||
temp = (d__1 = d_imag(&x[ix]), abs(d__1));
|
||||
if (d_lmp_imag(&x[ix]) != 0.) {
|
||||
temp = (d__1 = d_lmp_imag(&x[ix]), abs(d__1));
|
||||
if (scale < temp) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = scale / temp;
|
||||
|
||||
12
lib/linalg/i_lmp_dnnt.cpp
Normal file
12
lib/linalg/i_lmp_dnnt.cpp
Normal file
@ -0,0 +1,12 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
#undef abs
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
integer i_lmp_dnnt(doublereal *x)
|
||||
{
|
||||
return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
}
|
||||
10
lib/linalg/i_lmp_len.cpp
Normal file
10
lib/linalg/i_lmp_len.cpp
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
integer i_lmp_len(char *s, ftnlen n)
|
||||
{
|
||||
return (n);
|
||||
}
|
||||
}
|
||||
13
lib/linalg/i_lmp_nint.cpp
Normal file
13
lib/linalg/i_lmp_nint.cpp
Normal file
@ -0,0 +1,13 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
|
||||
integer i_lmp_nint(real *x)
|
||||
{
|
||||
return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
}
|
||||
@ -193,8 +193,8 @@ integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
|
||||
integer ret_val, i__1, i__2, i__3;
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
|
||||
integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
/* Subroutine */ int s_lmp_copy(char *, char *, ftnlen, ftnlen);
|
||||
integer i_lmp_len(char *, ftnlen), s_lmp_cmp(char *, char *, ftnlen, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
logical twostage;
|
||||
@ -257,7 +257,7 @@ L10:
|
||||
/* Convert NAME to upper case if the first character is lower case. */
|
||||
|
||||
ret_val = 1;
|
||||
s_copy(subnam, name__, (ftnlen)16, name_len);
|
||||
s_lmp_copy(subnam, name__, (ftnlen)16, name_len);
|
||||
ic = *(unsigned char *)subnam;
|
||||
iz = 'Z';
|
||||
if (iz == 90 || iz == 122) {
|
||||
@ -314,10 +314,10 @@ L10:
|
||||
if (! (cname || sname)) {
|
||||
return ret_val;
|
||||
}
|
||||
s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
|
||||
s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
|
||||
s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
|
||||
twostage = i_len(subnam, (ftnlen)16) >= 11 && *(unsigned char *)&subnam[
|
||||
s_lmp_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
|
||||
s_lmp_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
|
||||
s_lmp_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
|
||||
twostage = i_lmp_len(subnam, (ftnlen)16) >= 11 && *(unsigned char *)&subnam[
|
||||
10] == '2';
|
||||
|
||||
switch (*ispec) {
|
||||
@ -336,7 +336,7 @@ L50:
|
||||
|
||||
nb = 1;
|
||||
|
||||
if (s_cmp(subnam + 1, (char *)"LAORH", (ftnlen)5, (ftnlen)5) == 0) {
|
||||
if (s_lmp_cmp(subnam + 1, (char *)"LAORH", (ftnlen)5, (ftnlen)5) == 0) {
|
||||
|
||||
/* This is for *LAORHR_GETRFNP routine */
|
||||
|
||||
@ -345,23 +345,23 @@ L50:
|
||||
} else {
|
||||
nb = 32;
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"GE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"GE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 64;
|
||||
} else {
|
||||
nb = 64;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
|
||||
(char *)"RQF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, (char *)"LQF", (ftnlen)
|
||||
3, (ftnlen)3) == 0 || s_cmp(c3, (char *)"QLF", (ftnlen)3, (ftnlen)3)
|
||||
} else if (s_lmp_cmp(c3, (char *)"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_lmp_cmp(c3,
|
||||
(char *)"RQF", (ftnlen)3, (ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"LQF", (ftnlen)
|
||||
3, (ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"QLF", (ftnlen)3, (ftnlen)3)
|
||||
== 0) {
|
||||
if (sname) {
|
||||
nb = 32;
|
||||
} else {
|
||||
nb = 32;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"QR ", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"QR ", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (*n3 == 1) {
|
||||
if (sname) {
|
||||
/* M*N */
|
||||
@ -384,7 +384,7 @@ L50:
|
||||
nb = 1;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"LQ ", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"LQ ", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (*n3 == 2) {
|
||||
if (sname) {
|
||||
/* M*N */
|
||||
@ -407,35 +407,35 @@ L50:
|
||||
nb = 1;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 32;
|
||||
} else {
|
||||
nb = 32;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 32;
|
||||
} else {
|
||||
nb = 32;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 64;
|
||||
} else {
|
||||
nb = 64;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"PO", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"PO", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 64;
|
||||
} else {
|
||||
nb = 64;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"SY", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"SY", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
if (twostage) {
|
||||
nb = 192;
|
||||
@ -449,65 +449,65 @@ L50:
|
||||
nb = 64;
|
||||
}
|
||||
}
|
||||
} else if (sname && s_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (sname && s_lmp_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nb = 32;
|
||||
} else if (sname && s_cmp(c3, (char *)"GST", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (sname && s_lmp_cmp(c3, (char *)"GST", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nb = 64;
|
||||
}
|
||||
} else if (cname && s_cmp(c2, (char *)"HE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (cname && s_lmp_cmp(c2, (char *)"HE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (twostage) {
|
||||
nb = 192;
|
||||
} else {
|
||||
nb = 64;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nb = 32;
|
||||
} else if (s_cmp(c3, (char *)"GST", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"GST", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nb = 64;
|
||||
}
|
||||
} else if (sname && s_cmp(c2, (char *)"OR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (sname && s_lmp_cmp(c2, (char *)"OR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (*(unsigned char *)c3 == 'G') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nb = 32;
|
||||
}
|
||||
} else if (*(unsigned char *)c3 == 'M') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nb = 32;
|
||||
}
|
||||
}
|
||||
} else if (cname && s_cmp(c2, (char *)"UN", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (cname && s_lmp_cmp(c2, (char *)"UN", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (*(unsigned char *)c3 == 'G') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nb = 32;
|
||||
}
|
||||
} else if (*(unsigned char *)c3 == 'M') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nb = 32;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"GB", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"GB", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
if (*n4 <= 64) {
|
||||
nb = 1;
|
||||
@ -522,8 +522,8 @@ L50:
|
||||
}
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"PB", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"PB", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
if (*n2 <= 64) {
|
||||
nb = 1;
|
||||
@ -538,20 +538,20 @@ L50:
|
||||
}
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 64;
|
||||
} else {
|
||||
nb = 64;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"EVC", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"EVC", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 64;
|
||||
} else {
|
||||
nb = 64;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"SYL", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"SYL", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
/* The upper bound is to prevent overly aggressive scaling. */
|
||||
if (sname) {
|
||||
/* Computing MIN */
|
||||
@ -567,27 +567,27 @@ L50:
|
||||
nb = min(i__1,80);
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"LA", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"UUM", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"LA", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"UUM", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 64;
|
||||
} else {
|
||||
nb = 64;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"TRS", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"TRS", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 32;
|
||||
} else {
|
||||
nb = 32;
|
||||
}
|
||||
}
|
||||
} else if (sname && s_cmp(c2, (char *)"ST", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"EBZ", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (sname && s_lmp_cmp(c2, (char *)"ST", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"EBZ", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nb = 1;
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"GG", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"GG", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
nb = 32;
|
||||
if (s_cmp(c3, (char *)"HD3", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"HD3", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nb = 32;
|
||||
} else {
|
||||
@ -603,92 +603,92 @@ L60:
|
||||
/* ISPEC = 2: minimum block size */
|
||||
|
||||
nbmin = 2;
|
||||
if (s_cmp(c2, (char *)"GE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, (char *)"RQF", (
|
||||
ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, (char *)"LQF", (ftnlen)3, (
|
||||
ftnlen)3) == 0 || s_cmp(c3, (char *)"QLF", (ftnlen)3, (ftnlen)3) == 0)
|
||||
if (s_lmp_cmp(c2, (char *)"GE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"RQF", (
|
||||
ftnlen)3, (ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"LQF", (ftnlen)3, (
|
||||
ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"QLF", (ftnlen)3, (ftnlen)3) == 0)
|
||||
{
|
||||
if (sname) {
|
||||
nbmin = 2;
|
||||
} else {
|
||||
nbmin = 2;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nbmin = 2;
|
||||
} else {
|
||||
nbmin = 2;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nbmin = 2;
|
||||
} else {
|
||||
nbmin = 2;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"TRI", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nbmin = 2;
|
||||
} else {
|
||||
nbmin = 2;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"SY", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"SY", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRF", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nbmin = 8;
|
||||
} else {
|
||||
nbmin = 8;
|
||||
}
|
||||
} else if (sname && s_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (sname && s_lmp_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nbmin = 2;
|
||||
}
|
||||
} else if (cname && s_cmp(c2, (char *)"HE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (cname && s_lmp_cmp(c2, (char *)"HE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nbmin = 2;
|
||||
}
|
||||
} else if (sname && s_cmp(c2, (char *)"OR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (sname && s_lmp_cmp(c2, (char *)"OR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (*(unsigned char *)c3 == 'G') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nbmin = 2;
|
||||
}
|
||||
} else if (*(unsigned char *)c3 == 'M') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nbmin = 2;
|
||||
}
|
||||
}
|
||||
} else if (cname && s_cmp(c2, (char *)"UN", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (cname && s_lmp_cmp(c2, (char *)"UN", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (*(unsigned char *)c3 == 'G') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nbmin = 2;
|
||||
}
|
||||
} else if (*(unsigned char *)c3 == 'M') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nbmin = 2;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"GG", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"GG", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
nbmin = 2;
|
||||
if (s_cmp(c3, (char *)"HD3", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"HD3", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nbmin = 2;
|
||||
}
|
||||
}
|
||||
@ -700,62 +700,62 @@ L70:
|
||||
/* ISPEC = 3: crossover point */
|
||||
|
||||
nx = 0;
|
||||
if (s_cmp(c2, (char *)"GE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, (char *)"RQF", (
|
||||
ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, (char *)"LQF", (ftnlen)3, (
|
||||
ftnlen)3) == 0 || s_cmp(c3, (char *)"QLF", (ftnlen)3, (ftnlen)3) == 0)
|
||||
if (s_lmp_cmp(c2, (char *)"GE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"RQF", (
|
||||
ftnlen)3, (ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"LQF", (ftnlen)3, (
|
||||
ftnlen)3) == 0 || s_lmp_cmp(c3, (char *)"QLF", (ftnlen)3, (ftnlen)3) == 0)
|
||||
{
|
||||
if (sname) {
|
||||
nx = 128;
|
||||
} else {
|
||||
nx = 128;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"HRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nx = 128;
|
||||
} else {
|
||||
nx = 128;
|
||||
}
|
||||
} else if (s_cmp(c3, (char *)"BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c3, (char *)"BRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (sname) {
|
||||
nx = 128;
|
||||
} else {
|
||||
nx = 128;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"SY", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (sname && s_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"SY", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (sname && s_lmp_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nx = 32;
|
||||
}
|
||||
} else if (cname && s_cmp(c2, (char *)"HE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (cname && s_lmp_cmp(c2, (char *)"HE", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"TRD", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nx = 32;
|
||||
}
|
||||
} else if (sname && s_cmp(c2, (char *)"OR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (sname && s_lmp_cmp(c2, (char *)"OR", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (*(unsigned char *)c3 == 'G') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nx = 128;
|
||||
}
|
||||
}
|
||||
} else if (cname && s_cmp(c2, (char *)"UN", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (cname && s_lmp_cmp(c2, (char *)"UN", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
if (*(unsigned char *)c3 == 'G') {
|
||||
if (s_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, (char *)"BR", (
|
||||
if (s_lmp_cmp(c4, (char *)"QR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"RQ",
|
||||
(ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"LQ", (ftnlen)2, (
|
||||
ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"QL", (ftnlen)2, (ftnlen)2) ==
|
||||
0 || s_lmp_cmp(c4, (char *)"HR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(
|
||||
c4, (char *)"TR", (ftnlen)2, (ftnlen)2) == 0 || s_lmp_cmp(c4, (char *)"BR", (
|
||||
ftnlen)2, (ftnlen)2) == 0) {
|
||||
nx = 128;
|
||||
}
|
||||
}
|
||||
} else if (s_cmp(c2, (char *)"GG", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
} else if (s_lmp_cmp(c2, (char *)"GG", (ftnlen)2, (ftnlen)2) == 0) {
|
||||
nx = 128;
|
||||
if (s_cmp(c3, (char *)"HD3", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (s_lmp_cmp(c3, (char *)"HD3", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
nx = 128;
|
||||
}
|
||||
}
|
||||
|
||||
@ -255,9 +255,9 @@ integer iparmq_(integer *ispec, char *name__, char *opts, integer *n, integer
|
||||
|
||||
/* Builtin functions */
|
||||
double log(doublereal);
|
||||
integer i_nint(real *);
|
||||
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
|
||||
integer s_cmp(char *, char *, ftnlen, ftnlen);
|
||||
integer i_lmp_nint(real *);
|
||||
/* Subroutine */ int s_lmp_copy(char *, char *, ftnlen, ftnlen);
|
||||
integer s_lmp_cmp(char *, char *, ftnlen, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, ic, nh, ns, iz;
|
||||
@ -293,7 +293,7 @@ integer iparmq_(integer *ispec, char *name__, char *opts, integer *n, integer
|
||||
if (nh >= 150) {
|
||||
/* Computing MAX */
|
||||
r__1 = log((real) nh) / log((float)2.);
|
||||
i__1 = 10, i__2 = nh / i_nint(&r__1);
|
||||
i__1 = 10, i__2 = nh / i_lmp_nint(&r__1);
|
||||
ns = max(i__1,i__2);
|
||||
}
|
||||
if (nh >= 590) {
|
||||
@ -356,7 +356,7 @@ integer iparmq_(integer *ispec, char *name__, char *opts, integer *n, integer
|
||||
/* Convert NAME to upper case if the first character is lower case. */
|
||||
|
||||
ret_val = 0;
|
||||
s_copy(subnam, name__, (ftnlen)6, name_len);
|
||||
s_lmp_copy(subnam, name__, (ftnlen)6, name_len);
|
||||
ic = *(unsigned char *)subnam;
|
||||
iz = 'Z';
|
||||
if (iz == 90 || iz == 122) {
|
||||
@ -404,21 +404,21 @@ integer iparmq_(integer *ispec, char *name__, char *opts, integer *n, integer
|
||||
}
|
||||
}
|
||||
|
||||
if (s_cmp(subnam + 1, (char *)"GGHRD", (ftnlen)5, (ftnlen)5) == 0 || s_cmp(
|
||||
if (s_lmp_cmp(subnam + 1, (char *)"GGHRD", (ftnlen)5, (ftnlen)5) == 0 || s_lmp_cmp(
|
||||
subnam + 1, (char *)"GGHD3", (ftnlen)5, (ftnlen)5) == 0) {
|
||||
ret_val = 1;
|
||||
if (nh >= 14) {
|
||||
ret_val = 2;
|
||||
}
|
||||
} else if (s_cmp(subnam + 3, (char *)"EXC", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
} else if (s_lmp_cmp(subnam + 3, (char *)"EXC", (ftnlen)3, (ftnlen)3) == 0) {
|
||||
if (nh >= 14) {
|
||||
ret_val = 1;
|
||||
}
|
||||
if (nh >= 14) {
|
||||
ret_val = 2;
|
||||
}
|
||||
} else if (s_cmp(subnam + 1, (char *)"HSEQR", (ftnlen)5, (ftnlen)5) == 0 ||
|
||||
s_cmp(subnam + 1, (char *)"LAQR", (ftnlen)4, (ftnlen)4) == 0) {
|
||||
} else if (s_lmp_cmp(subnam + 1, (char *)"HSEQR", (ftnlen)5, (ftnlen)5) == 0 ||
|
||||
s_lmp_cmp(subnam + 1, (char *)"LAQR", (ftnlen)4, (ftnlen)4) == 0) {
|
||||
if (ns >= 14) {
|
||||
ret_val = 1;
|
||||
}
|
||||
|
||||
12
lib/linalg/pow_lmp_dd.cpp
Normal file
12
lib/linalg/pow_lmp_dd.cpp
Normal file
@ -0,0 +1,12 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
double pow_lmp_dd(doublereal *ap, doublereal *bp)
|
||||
{
|
||||
return (pow(*ap, *bp));
|
||||
}
|
||||
}
|
||||
31
lib/linalg/pow_lmp_di.cpp
Normal file
31
lib/linalg/pow_lmp_di.cpp
Normal file
@ -0,0 +1,31 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
double pow_lmp_di(doublereal *ap, integer *bp)
|
||||
{
|
||||
double pow, x;
|
||||
integer n;
|
||||
unsigned long u;
|
||||
|
||||
pow = 1;
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if (n != 0) {
|
||||
if (n < 0) {
|
||||
n = -n;
|
||||
x = 1 / x;
|
||||
}
|
||||
for (u = n;;) {
|
||||
if (u & 01) pow *= x;
|
||||
if (u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
}
|
||||
return (pow);
|
||||
}
|
||||
}
|
||||
29
lib/linalg/pow_lmp_ii.cpp
Normal file
29
lib/linalg/pow_lmp_ii.cpp
Normal file
@ -0,0 +1,29 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
integer pow_lmp_ii(integer *ap, integer *bp)
|
||||
{
|
||||
integer pow, x, n;
|
||||
unsigned long u;
|
||||
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) return 1;
|
||||
if (x != -1) return x == 0 ? 1 / x : 0;
|
||||
n = -n;
|
||||
}
|
||||
u = n;
|
||||
for (pow = 1;;) {
|
||||
if (u & 01) pow *= x;
|
||||
if (u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
return (pow);
|
||||
}
|
||||
}
|
||||
23
lib/linalg/s_lmp_cat.cpp
Normal file
23
lib/linalg/s_lmp_cat.cpp
Normal file
@ -0,0 +1,23 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
// concatenate two strings
|
||||
|
||||
extern "C" {
|
||||
void s_lmp_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll)
|
||||
{
|
||||
ftnlen i, nc;
|
||||
char *rp;
|
||||
ftnlen n = *np;
|
||||
for (i = 0; i < n; ++i) {
|
||||
nc = ll;
|
||||
if (rnp[i] < nc) nc = rnp[i];
|
||||
ll -= nc;
|
||||
rp = rpp[i];
|
||||
while (--nc >= 0)
|
||||
*lp++ = *rp++;
|
||||
}
|
||||
while (--ll >= 0)
|
||||
*lp++ = ' ';
|
||||
}
|
||||
}
|
||||
45
lib/linalg/s_lmp_cmp.cpp
Normal file
45
lib/linalg/s_lmp_cmp.cpp
Normal file
@ -0,0 +1,45 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
// compare two strings
|
||||
|
||||
integer s_lmp_cmp(char *a0, char *b0, ftnlen la, ftnlen lb)
|
||||
{
|
||||
register unsigned char *a, *aend, *b, *bend;
|
||||
a = (unsigned char *)a0;
|
||||
b = (unsigned char *)b0;
|
||||
aend = a + la;
|
||||
bend = b + lb;
|
||||
|
||||
if (la <= lb) {
|
||||
while (a < aend)
|
||||
if (*a != *b)
|
||||
return (*a - *b);
|
||||
else {
|
||||
++a;
|
||||
++b;
|
||||
}
|
||||
|
||||
while (b < bend)
|
||||
if (*b != ' ')
|
||||
return (' ' - *b);
|
||||
else
|
||||
++b;
|
||||
} else {
|
||||
while (b < bend)
|
||||
if (*a == *b) {
|
||||
++a;
|
||||
++b;
|
||||
} else
|
||||
return (*a - *b);
|
||||
while (a < aend)
|
||||
if (*a != ' ')
|
||||
return (*a - ' ');
|
||||
else
|
||||
++a;
|
||||
}
|
||||
return (0);
|
||||
}
|
||||
}
|
||||
26
lib/linalg/s_lmp_copy.cpp
Normal file
26
lib/linalg/s_lmp_copy.cpp
Normal file
@ -0,0 +1,26 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
/* assign strings: a = b */
|
||||
|
||||
void s_lmp_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
|
||||
{
|
||||
register char *aend, *bend;
|
||||
|
||||
aend = a + la;
|
||||
|
||||
if (la <= lb)
|
||||
while (a < aend)
|
||||
*a++ = *b++;
|
||||
|
||||
else {
|
||||
bend = b + lb;
|
||||
while (b < bend)
|
||||
*a++ = *b++;
|
||||
while (a < aend)
|
||||
*a++ = ' ';
|
||||
}
|
||||
}
|
||||
}
|
||||
23
lib/linalg/static/.clang-format
Normal file
23
lib/linalg/static/.clang-format
Normal file
@ -0,0 +1,23 @@
|
||||
---
|
||||
Language: Cpp
|
||||
BasedOnStyle: LLVM
|
||||
AccessModifierOffset: -4
|
||||
AlignConsecutiveAssignments: true
|
||||
AlignEscapedNewlines: Left
|
||||
AllowShortFunctionsOnASingleLine: Inline
|
||||
AllowShortLambdasOnASingleLine: None
|
||||
AllowShortIfStatementsOnASingleLine: WithoutElse
|
||||
BraceWrapping:
|
||||
AfterFunction: true
|
||||
BreakBeforeBraces: Custom
|
||||
BreakInheritanceList: AfterColon
|
||||
BreakConstructorInitializers: AfterColon
|
||||
ColumnLimit: 100
|
||||
IndentCaseLabels: true
|
||||
IndentWidth: 4
|
||||
ObjCBlockIndentWidth: 4
|
||||
PenaltyBreakAssignment: 4
|
||||
Standard: Cpp11
|
||||
TabWidth: 4
|
||||
UseTab: Never
|
||||
...
|
||||
@ -1,5 +1,8 @@
|
||||
The C++ files in this folder are direct C++ implementations of their
|
||||
Fortran equivalents using the C++ runtime.
|
||||
.
|
||||
The C++ files in this folder are either direct C++ implementations of
|
||||
their Fortran equivalents using the C++ runtime, or they are adapted
|
||||
copies of functions from the libf2c runtime. The runtime functions
|
||||
needed to be renamed to avoid conflics with libgfortran which uses
|
||||
some of the same function names.
|
||||
|
||||
The Fortran files in this folder are modified from their
|
||||
original versions, so that f2c can correctly translate them.
|
||||
|
||||
13
lib/linalg/static/d_lmp_cnjg.cpp
Normal file
13
lib/linalg/static/d_lmp_cnjg.cpp
Normal file
@ -0,0 +1,13 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
void d_lmp_cnjg(doublecomplex *r, doublecomplex *z)
|
||||
{
|
||||
doublereal zi = z->i;
|
||||
|
||||
r->r = z->r;
|
||||
r->i = -zi;
|
||||
}
|
||||
}
|
||||
10
lib/linalg/static/d_lmp_imag.cpp
Normal file
10
lib/linalg/static/d_lmp_imag.cpp
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
double d_lmp_imag(doublecomplex *z)
|
||||
{
|
||||
return (z->i);
|
||||
}
|
||||
}
|
||||
14
lib/linalg/static/d_lmp_lg10.cpp
Normal file
14
lib/linalg/static/d_lmp_lg10.cpp
Normal file
@ -0,0 +1,14 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
static constexpr double log10e = 0.43429448190325182765;
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
double d_lmp_lg10(doublereal *x)
|
||||
{
|
||||
return (log10e * log(*x));
|
||||
}
|
||||
}
|
||||
12
lib/linalg/static/d_lmp_sign.cpp
Normal file
12
lib/linalg/static/d_lmp_sign.cpp
Normal file
@ -0,0 +1,12 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
double d_lmp_sign(doublereal *a, doublereal *b)
|
||||
{
|
||||
double x;
|
||||
x = (*a >= 0 ? *a : -*a);
|
||||
return (*b >= 0 ? x : -x);
|
||||
}
|
||||
}
|
||||
45
lib/linalg/static/dlamc3.f
Normal file
45
lib/linalg/static/dlamc3.f
Normal file
@ -0,0 +1,45 @@
|
||||
*> \brief \b DLAMC3
|
||||
*> \details
|
||||
*> \b Purpose:
|
||||
*> \verbatim
|
||||
*> DLAMC3 is intended to force A and B to be stored prior to doing
|
||||
*> the addition of A and B , for use in situations where optimizers
|
||||
*> might hold one of these in a register.
|
||||
*> \endverbatim
|
||||
*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
|
||||
*> \date December 2016
|
||||
*> \ingroup auxOTHERauxiliary
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is a DOUBLE PRECISION
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] B
|
||||
*> \verbatim
|
||||
*> B is a DOUBLE PRECISION
|
||||
*> The values A and B.
|
||||
*> \endverbatim
|
||||
*>
|
||||
DOUBLE PRECISION FUNCTION DLAMC3( A, B )
|
||||
*
|
||||
* -- LAPACK auxiliary routine (version 3.7.0) --
|
||||
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
|
||||
* November 2010
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION A, B
|
||||
* ..
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
DLAMC3 = A + B
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DLAMC3
|
||||
*
|
||||
END
|
||||
*
|
||||
************************************************************************
|
||||
12
lib/linalg/static/i_lmp_dnnt.cpp
Normal file
12
lib/linalg/static/i_lmp_dnnt.cpp
Normal file
@ -0,0 +1,12 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
#undef abs
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
integer i_lmp_dnnt(doublereal *x)
|
||||
{
|
||||
return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
}
|
||||
10
lib/linalg/static/i_lmp_len.cpp
Normal file
10
lib/linalg/static/i_lmp_len.cpp
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
integer i_lmp_len(char *s, ftnlen n)
|
||||
{
|
||||
return (n);
|
||||
}
|
||||
}
|
||||
13
lib/linalg/static/i_lmp_nint.cpp
Normal file
13
lib/linalg/static/i_lmp_nint.cpp
Normal file
@ -0,0 +1,13 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
|
||||
integer i_lmp_nint(real *x)
|
||||
{
|
||||
return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
|
||||
}
|
||||
}
|
||||
12
lib/linalg/static/pow_lmp_dd.cpp
Normal file
12
lib/linalg/static/pow_lmp_dd.cpp
Normal file
@ -0,0 +1,12 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
double pow_lmp_dd(doublereal *ap, doublereal *bp)
|
||||
{
|
||||
return (pow(*ap, *bp));
|
||||
}
|
||||
}
|
||||
31
lib/linalg/static/pow_lmp_di.cpp
Normal file
31
lib/linalg/static/pow_lmp_di.cpp
Normal file
@ -0,0 +1,31 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
double pow_lmp_di(doublereal *ap, integer *bp)
|
||||
{
|
||||
double pow, x;
|
||||
integer n;
|
||||
unsigned long u;
|
||||
|
||||
pow = 1;
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if (n != 0) {
|
||||
if (n < 0) {
|
||||
n = -n;
|
||||
x = 1 / x;
|
||||
}
|
||||
for (u = n;;) {
|
||||
if (u & 01) pow *= x;
|
||||
if (u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
}
|
||||
return (pow);
|
||||
}
|
||||
}
|
||||
29
lib/linalg/static/pow_lmp_ii.cpp
Normal file
29
lib/linalg/static/pow_lmp_ii.cpp
Normal file
@ -0,0 +1,29 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
integer pow_lmp_ii(integer *ap, integer *bp)
|
||||
{
|
||||
integer pow, x, n;
|
||||
unsigned long u;
|
||||
|
||||
x = *ap;
|
||||
n = *bp;
|
||||
|
||||
if (n <= 0) {
|
||||
if (n == 0 || x == 1) return 1;
|
||||
if (x != -1) return x == 0 ? 1 / x : 0;
|
||||
n = -n;
|
||||
}
|
||||
u = n;
|
||||
for (pow = 1;;) {
|
||||
if (u & 01) pow *= x;
|
||||
if (u >>= 1)
|
||||
x *= x;
|
||||
else
|
||||
break;
|
||||
}
|
||||
return (pow);
|
||||
}
|
||||
}
|
||||
23
lib/linalg/static/s_lmp_cat.cpp
Normal file
23
lib/linalg/static/s_lmp_cat.cpp
Normal file
@ -0,0 +1,23 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
// concatenate two strings
|
||||
|
||||
extern "C" {
|
||||
void s_lmp_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll)
|
||||
{
|
||||
ftnlen i, nc;
|
||||
char *rp;
|
||||
ftnlen n = *np;
|
||||
for (i = 0; i < n; ++i) {
|
||||
nc = ll;
|
||||
if (rnp[i] < nc) nc = rnp[i];
|
||||
ll -= nc;
|
||||
rp = rpp[i];
|
||||
while (--nc >= 0)
|
||||
*lp++ = *rp++;
|
||||
}
|
||||
while (--ll >= 0)
|
||||
*lp++ = ' ';
|
||||
}
|
||||
}
|
||||
45
lib/linalg/static/s_lmp_cmp.cpp
Normal file
45
lib/linalg/static/s_lmp_cmp.cpp
Normal file
@ -0,0 +1,45 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
// compare two strings
|
||||
|
||||
integer s_lmp_cmp(char *a0, char *b0, ftnlen la, ftnlen lb)
|
||||
{
|
||||
register unsigned char *a, *aend, *b, *bend;
|
||||
a = (unsigned char *)a0;
|
||||
b = (unsigned char *)b0;
|
||||
aend = a + la;
|
||||
bend = b + lb;
|
||||
|
||||
if (la <= lb) {
|
||||
while (a < aend)
|
||||
if (*a != *b)
|
||||
return (*a - *b);
|
||||
else {
|
||||
++a;
|
||||
++b;
|
||||
}
|
||||
|
||||
while (b < bend)
|
||||
if (*b != ' ')
|
||||
return (' ' - *b);
|
||||
else
|
||||
++b;
|
||||
} else {
|
||||
while (b < bend)
|
||||
if (*a == *b) {
|
||||
++a;
|
||||
++b;
|
||||
} else
|
||||
return (*a - *b);
|
||||
while (a < aend)
|
||||
if (*a != ' ')
|
||||
return (*a - ' ');
|
||||
else
|
||||
++a;
|
||||
}
|
||||
return (0);
|
||||
}
|
||||
}
|
||||
26
lib/linalg/static/s_lmp_copy.cpp
Normal file
26
lib/linalg/static/s_lmp_copy.cpp
Normal file
@ -0,0 +1,26 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
/* assign strings: a = b */
|
||||
|
||||
void s_lmp_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
|
||||
{
|
||||
register char *aend, *bend;
|
||||
|
||||
aend = a + la;
|
||||
|
||||
if (la <= lb)
|
||||
while (a < aend)
|
||||
*a++ = *b++;
|
||||
|
||||
else {
|
||||
bend = b + lb;
|
||||
while (b < bend)
|
||||
*a++ = *b++;
|
||||
while (a < aend)
|
||||
*a++ = ' ';
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1,30 +1,31 @@
|
||||
|
||||
#include <exception>
|
||||
#include <string>
|
||||
|
||||
class LinalgException : public std::exception {
|
||||
std::string message;
|
||||
|
||||
public:
|
||||
LinalgException() = delete;
|
||||
|
||||
explicit LinalgException(const std::string &msg) { message = msg; }
|
||||
const char *what() const noexcept override { return message.c_str(); }
|
||||
};
|
||||
|
||||
extern "C" {
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
#undef abs
|
||||
#include <cstdio>
|
||||
#include <cstdlib>
|
||||
#include <cstring>
|
||||
|
||||
extern "C" {
|
||||
|
||||
static constexpr int BUFSZ = 1024;
|
||||
|
||||
integer xerbla_(const char *srname, integer *info)
|
||||
{
|
||||
std::string mesg = " ** On entry to ";
|
||||
for (int i = 0; i < 1024; ++i) {
|
||||
if ((srname[i] == '\0') || (srname[i] == ' ')) break;
|
||||
mesg.push_back(srname[i]);
|
||||
char buf[BUFSZ];
|
||||
buf[0] = '\0';
|
||||
|
||||
strcat(buf, " ** On entry to ");
|
||||
for (int i = 0; i < BUFSZ - 16; ++i) {
|
||||
if ((srname[i] == '\0') || (srname[i] == ' ')) {
|
||||
buf[i + 16] = '\0';
|
||||
break;
|
||||
}
|
||||
mesg += " parameter number " + std::to_string(*info) + " had an illegal value\n";
|
||||
throw LinalgException(mesg);
|
||||
buf[i + 16] = srname[i];
|
||||
}
|
||||
int len = strlen(buf);
|
||||
snprintf(buf+len, BUFSZ-len, " parameter number %d had an illegal value\n", *info);
|
||||
exit(1);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
31
lib/linalg/static/z_lmp_abs.cpp
Normal file
31
lib/linalg/static/z_lmp_abs.cpp
Normal file
@ -0,0 +1,31 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
|
||||
static double f__cabs(double real, double imag)
|
||||
{
|
||||
double temp;
|
||||
|
||||
if (real < 0) real = -real;
|
||||
if (imag < 0) imag = -imag;
|
||||
if (imag > real) {
|
||||
temp = real;
|
||||
real = imag;
|
||||
imag = temp;
|
||||
}
|
||||
if ((real + imag) == real) return (real);
|
||||
|
||||
temp = imag / real;
|
||||
temp = real * sqrt(1.0 + temp * temp); /*overflow!!*/
|
||||
return (temp);
|
||||
}
|
||||
|
||||
double z_lmp_abs(doublecomplex *z)
|
||||
{
|
||||
return (f__cabs(z->r, z->i));
|
||||
}
|
||||
}
|
||||
31
lib/linalg/static/z_lmp_div.cpp
Normal file
31
lib/linalg/static/z_lmp_div.cpp
Normal file
@ -0,0 +1,31 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
void z_lmp_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
|
||||
{
|
||||
double ratio, den;
|
||||
double abr, abi, cr;
|
||||
|
||||
if ((abr = b->r) < 0.) abr = -abr;
|
||||
if ((abi = b->i) < 0.) abi = -abi;
|
||||
if (abr <= abi) {
|
||||
if (abi == 0) {
|
||||
if (a->i != 0 || a->r != 0) abi = 1.;
|
||||
c->i = c->r = abi / abr;
|
||||
return;
|
||||
}
|
||||
ratio = b->r / b->i;
|
||||
den = b->i * (1 + ratio * ratio);
|
||||
cr = (a->r * ratio + a->i) / den;
|
||||
c->i = (a->i * ratio - a->r) / den;
|
||||
} else {
|
||||
ratio = b->i / b->r;
|
||||
den = b->r * (1 + ratio * ratio);
|
||||
cr = (a->r + a->i * ratio) / den;
|
||||
c->i = (a->i - a->r * ratio) / den;
|
||||
}
|
||||
c->r = cr;
|
||||
}
|
||||
}
|
||||
13
lib/linalg/whitespace.conf
Normal file
13
lib/linalg/whitespace.conf
Normal file
@ -0,0 +1,13 @@
|
||||
---
|
||||
recursive: false
|
||||
include:
|
||||
- "."
|
||||
- "static/**"
|
||||
exclude:
|
||||
- "Makefile.*"
|
||||
- "*.py"
|
||||
patterns:
|
||||
- "*.cpp"
|
||||
- "*.h"
|
||||
- "README"
|
||||
...
|
||||
@ -1,30 +1,31 @@
|
||||
|
||||
#include <exception>
|
||||
#include <string>
|
||||
|
||||
class LinalgException : public std::exception {
|
||||
std::string message;
|
||||
|
||||
public:
|
||||
LinalgException() = delete;
|
||||
|
||||
explicit LinalgException(const std::string &msg) { message = msg; }
|
||||
const char *what() const noexcept override { return message.c_str(); }
|
||||
};
|
||||
|
||||
extern "C" {
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
#undef abs
|
||||
#include <cstdio>
|
||||
#include <cstdlib>
|
||||
#include <cstring>
|
||||
|
||||
extern "C" {
|
||||
|
||||
static constexpr int BUFSZ = 1024;
|
||||
|
||||
integer xerbla_(const char *srname, integer *info)
|
||||
{
|
||||
std::string mesg = " ** On entry to ";
|
||||
for (int i = 0; i < 1024; ++i) {
|
||||
if ((srname[i] == '\0') || (srname[i] == ' ')) break;
|
||||
mesg.push_back(srname[i]);
|
||||
char buf[BUFSZ];
|
||||
buf[0] = '\0';
|
||||
|
||||
strcat(buf, " ** On entry to ");
|
||||
for (int i = 0; i < BUFSZ - 16; ++i) {
|
||||
if ((srname[i] == '\0') || (srname[i] == ' ')) {
|
||||
buf[i + 16] = '\0';
|
||||
break;
|
||||
}
|
||||
mesg += " parameter number " + std::to_string(*info) + " had an illegal value\n";
|
||||
throw LinalgException(mesg);
|
||||
buf[i + 16] = srname[i];
|
||||
}
|
||||
int len = strlen(buf);
|
||||
snprintf(buf+len, BUFSZ-len, " parameter number %d had an illegal value\n", *info);
|
||||
exit(1);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
31
lib/linalg/z_lmp_abs.cpp
Normal file
31
lib/linalg/z_lmp_abs.cpp
Normal file
@ -0,0 +1,31 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
#undef abs
|
||||
|
||||
#include <cmath>
|
||||
|
||||
extern "C" {
|
||||
|
||||
static double f__cabs(double real, double imag)
|
||||
{
|
||||
double temp;
|
||||
|
||||
if (real < 0) real = -real;
|
||||
if (imag < 0) imag = -imag;
|
||||
if (imag > real) {
|
||||
temp = real;
|
||||
real = imag;
|
||||
imag = temp;
|
||||
}
|
||||
if ((real + imag) == real) return (real);
|
||||
|
||||
temp = imag / real;
|
||||
temp = real * sqrt(1.0 + temp * temp); /*overflow!!*/
|
||||
return (temp);
|
||||
}
|
||||
|
||||
double z_lmp_abs(doublecomplex *z)
|
||||
{
|
||||
return (f__cabs(z->r, z->i));
|
||||
}
|
||||
}
|
||||
31
lib/linalg/z_lmp_div.cpp
Normal file
31
lib/linalg/z_lmp_div.cpp
Normal file
@ -0,0 +1,31 @@
|
||||
|
||||
#include "lmp_f2c.h"
|
||||
|
||||
extern "C" {
|
||||
|
||||
void z_lmp_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
|
||||
{
|
||||
double ratio, den;
|
||||
double abr, abi, cr;
|
||||
|
||||
if ((abr = b->r) < 0.) abr = -abr;
|
||||
if ((abi = b->i) < 0.) abi = -abi;
|
||||
if (abr <= abi) {
|
||||
if (abi == 0) {
|
||||
if (a->i != 0 || a->r != 0) abi = 1.;
|
||||
c->i = c->r = abi / abr;
|
||||
return;
|
||||
}
|
||||
ratio = b->r / b->i;
|
||||
den = b->i * (1 + ratio * ratio);
|
||||
cr = (a->r * ratio + a->i) / den;
|
||||
c->i = (a->i * ratio - a->r) / den;
|
||||
} else {
|
||||
ratio = b->i / b->r;
|
||||
den = b->r * (1 + ratio * ratio);
|
||||
cr = (a->r + a->i * ratio) / den;
|
||||
c->i = (a->i - a->r * ratio) / den;
|
||||
}
|
||||
c->r = cr;
|
||||
}
|
||||
}
|
||||
@ -104,7 +104,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, ix, iy;
|
||||
@ -142,7 +142,7 @@ extern "C" {
|
||||
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
d_cnjg(&z__3, &zx[i__]);
|
||||
d_lmp_cnjg(&z__3, &zx[i__]);
|
||||
i__2 = i__;
|
||||
z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i =
|
||||
z__3.r * zy[i__2].i + z__3.i * zy[i__2].r;
|
||||
@ -164,7 +164,7 @@ extern "C" {
|
||||
}
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
d_cnjg(&z__3, &zx[ix]);
|
||||
d_lmp_cnjg(&z__3, &zx[ix]);
|
||||
i__2 = iy;
|
||||
z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i =
|
||||
z__3.r * zy[i__2].i + z__3.i * zy[i__2].r;
|
||||
|
||||
@ -100,7 +100,7 @@ extern "C" {
|
||||
doublecomplex z__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_imag(doublecomplex *);
|
||||
double d_lmp_imag(doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, nincx;
|
||||
@ -138,7 +138,7 @@ extern "C" {
|
||||
i__2 = i__;
|
||||
i__3 = i__;
|
||||
d__1 = *da * zx[i__3].r;
|
||||
d__2 = *da * d_imag(&zx[i__]);
|
||||
d__2 = *da * d_lmp_imag(&zx[i__]);
|
||||
z__1.r = d__1, z__1.i = d__2;
|
||||
zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
|
||||
}
|
||||
@ -153,7 +153,7 @@ extern "C" {
|
||||
i__3 = i__;
|
||||
i__4 = i__;
|
||||
d__1 = *da * zx[i__4].r;
|
||||
d__2 = *da * d_imag(&zx[i__]);
|
||||
d__2 = *da * d_lmp_imag(&zx[i__]);
|
||||
z__1.r = d__1, z__1.i = d__2;
|
||||
zx[i__3].r = z__1.r, zx[i__3].i = z__1.i;
|
||||
}
|
||||
|
||||
@ -211,7 +211,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3, z__4;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, l, info;
|
||||
@ -406,7 +406,7 @@ extern "C" {
|
||||
temp.r = 0., temp.i = 0.;
|
||||
i__3 = *k;
|
||||
for (l = 1; l <= i__3; ++l) {
|
||||
d_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
i__4 = l + j * b_dim1;
|
||||
z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
|
||||
z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
|
||||
@ -508,7 +508,7 @@ extern "C" {
|
||||
}
|
||||
i__2 = *k;
|
||||
for (l = 1; l <= i__2; ++l) {
|
||||
d_cnjg(&z__2, &b[j + l * b_dim1]);
|
||||
d_lmp_cnjg(&z__2, &b[j + l * b_dim1]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
|
||||
alpha->r * z__2.i + alpha->i * z__2.r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
@ -591,8 +591,8 @@ extern "C" {
|
||||
temp.r = 0., temp.i = 0.;
|
||||
i__3 = *k;
|
||||
for (l = 1; l <= i__3; ++l) {
|
||||
d_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
d_cnjg(&z__4, &b[j + l * b_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__4, &b[j + l * b_dim1]);
|
||||
z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, z__2.i =
|
||||
z__3.r * z__4.i + z__3.i * z__4.r;
|
||||
z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
|
||||
@ -632,7 +632,7 @@ extern "C" {
|
||||
temp.r = 0., temp.i = 0.;
|
||||
i__3 = *k;
|
||||
for (l = 1; l <= i__3; ++l) {
|
||||
d_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
i__4 = j + l * b_dim1;
|
||||
z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
|
||||
z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
|
||||
@ -677,7 +677,7 @@ extern "C" {
|
||||
i__3 = *k;
|
||||
for (l = 1; l <= i__3; ++l) {
|
||||
i__4 = l + i__ * a_dim1;
|
||||
d_cnjg(&z__3, &b[j + l * b_dim1]);
|
||||
d_lmp_cnjg(&z__3, &b[j + l * b_dim1]);
|
||||
z__2.r = a[i__4].r * z__3.r - a[i__4].i * z__3.i,
|
||||
z__2.i = a[i__4].r * z__3.i + a[i__4].i *
|
||||
z__3.r;
|
||||
|
||||
@ -181,7 +181,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, ix, iy, jx, jy, kx, ky, info;
|
||||
@ -403,7 +403,7 @@ extern "C" {
|
||||
} else {
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = i__;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
|
||||
@ -443,7 +443,7 @@ extern "C" {
|
||||
} else {
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = ix;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
|
||||
|
||||
@ -152,7 +152,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, ix, jy, kx, info;
|
||||
@ -226,7 +226,7 @@ extern "C" {
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = jy;
|
||||
if (y[i__2].r != 0. || y[i__2].i != 0.) {
|
||||
d_cnjg(&z__2, &y[jy]);
|
||||
d_lmp_cnjg(&z__2, &y[jy]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
|
||||
alpha->r * z__2.i + alpha->i * z__2.r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
@ -255,7 +255,7 @@ extern "C" {
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = jy;
|
||||
if (y[i__2].r != 0. || y[i__2].i != 0.) {
|
||||
d_cnjg(&z__2, &y[jy]);
|
||||
d_lmp_cnjg(&z__2, &y[jy]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
|
||||
alpha->r * z__2.i + alpha->i * z__2.r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
|
||||
@ -177,7 +177,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3, z__4;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, ix, iy, jx, jy, kx, ky, info;
|
||||
@ -333,7 +333,7 @@ extern "C" {
|
||||
.r;
|
||||
z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
|
||||
y[i__3].r = z__1.r, y[i__3].i = z__1.i;
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = i__;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
|
||||
z__3.r * x[i__3].i + z__3.i * x[i__3].r;
|
||||
@ -375,7 +375,7 @@ extern "C" {
|
||||
.r;
|
||||
z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
|
||||
y[i__3].r = z__1.r, y[i__3].i = z__1.i;
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = ix;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
|
||||
z__3.r * x[i__3].i + z__3.i * x[i__3].r;
|
||||
@ -429,7 +429,7 @@ extern "C" {
|
||||
.r;
|
||||
z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
|
||||
y[i__3].r = z__1.r, y[i__3].i = z__1.i;
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = i__;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
|
||||
z__3.r * x[i__3].i + z__3.i * x[i__3].r;
|
||||
@ -476,7 +476,7 @@ extern "C" {
|
||||
.r;
|
||||
z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
|
||||
y[i__3].r = z__1.r, y[i__3].i = z__1.i;
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = ix;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
|
||||
z__3.r * x[i__3].i + z__3.i * x[i__3].r;
|
||||
|
||||
@ -173,7 +173,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3, z__4;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, ix, iy, jx, jy, kx, ky, info;
|
||||
@ -271,7 +271,7 @@ extern "C" {
|
||||
i__3 = j;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
|
||||
y[i__3].i != 0.)) {
|
||||
d_cnjg(&z__2, &y[j]);
|
||||
d_lmp_cnjg(&z__2, &y[j]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
|
||||
alpha->r * z__2.i + alpha->i * z__2.r;
|
||||
temp1.r = z__1.r, temp1.i = z__1.i;
|
||||
@ -279,7 +279,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
|
||||
z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
|
||||
.r;
|
||||
d_cnjg(&z__1, &z__2);
|
||||
d_lmp_cnjg(&z__1, &z__2);
|
||||
temp2.r = z__1.r, temp2.i = z__1.i;
|
||||
i__2 = j - 1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
@ -327,7 +327,7 @@ extern "C" {
|
||||
i__3 = jy;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
|
||||
y[i__3].i != 0.)) {
|
||||
d_cnjg(&z__2, &y[jy]);
|
||||
d_lmp_cnjg(&z__2, &y[jy]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
|
||||
alpha->r * z__2.i + alpha->i * z__2.r;
|
||||
temp1.r = z__1.r, temp1.i = z__1.i;
|
||||
@ -335,7 +335,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
|
||||
z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
|
||||
.r;
|
||||
d_cnjg(&z__1, &z__2);
|
||||
d_lmp_cnjg(&z__1, &z__2);
|
||||
temp2.r = z__1.r, temp2.i = z__1.i;
|
||||
ix = kx;
|
||||
iy = ky;
|
||||
@ -394,7 +394,7 @@ extern "C" {
|
||||
i__3 = j;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
|
||||
y[i__3].i != 0.)) {
|
||||
d_cnjg(&z__2, &y[j]);
|
||||
d_lmp_cnjg(&z__2, &y[j]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
|
||||
alpha->r * z__2.i + alpha->i * z__2.r;
|
||||
temp1.r = z__1.r, temp1.i = z__1.i;
|
||||
@ -402,7 +402,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
|
||||
z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
|
||||
.r;
|
||||
d_cnjg(&z__1, &z__2);
|
||||
d_lmp_cnjg(&z__1, &z__2);
|
||||
temp2.r = z__1.r, temp2.i = z__1.i;
|
||||
i__2 = j + j * a_dim1;
|
||||
i__3 = j + j * a_dim1;
|
||||
@ -450,7 +450,7 @@ extern "C" {
|
||||
i__3 = jy;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
|
||||
y[i__3].i != 0.)) {
|
||||
d_cnjg(&z__2, &y[jy]);
|
||||
d_lmp_cnjg(&z__2, &y[jy]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
|
||||
alpha->r * z__2.i + alpha->i * z__2.r;
|
||||
temp1.r = z__1.r, temp1.i = z__1.i;
|
||||
@ -458,7 +458,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
|
||||
z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
|
||||
.r;
|
||||
d_cnjg(&z__1, &z__2);
|
||||
d_lmp_cnjg(&z__1, &z__2);
|
||||
temp2.r = z__1.r, temp2.i = z__1.i;
|
||||
i__2 = j + j * a_dim1;
|
||||
i__3 = j + j * a_dim1;
|
||||
|
||||
@ -223,7 +223,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, l, info;
|
||||
@ -418,7 +418,7 @@ extern "C" {
|
||||
i__4 = j + l * b_dim1;
|
||||
if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=
|
||||
0. || b[i__4].i != 0.)) {
|
||||
d_cnjg(&z__2, &b[j + l * b_dim1]);
|
||||
d_lmp_cnjg(&z__2, &b[j + l * b_dim1]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
|
||||
z__1.i = alpha->r * z__2.i + alpha->i *
|
||||
z__2.r;
|
||||
@ -427,7 +427,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,
|
||||
z__2.i = alpha->r * a[i__3].i + alpha->i * a[
|
||||
i__3].r;
|
||||
d_cnjg(&z__1, &z__2);
|
||||
d_lmp_cnjg(&z__1, &z__2);
|
||||
temp2.r = z__1.r, temp2.i = z__1.i;
|
||||
i__3 = j - 1;
|
||||
for (i__ = 1; i__ <= i__3; ++i__) {
|
||||
@ -502,7 +502,7 @@ extern "C" {
|
||||
i__4 = j + l * b_dim1;
|
||||
if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=
|
||||
0. || b[i__4].i != 0.)) {
|
||||
d_cnjg(&z__2, &b[j + l * b_dim1]);
|
||||
d_lmp_cnjg(&z__2, &b[j + l * b_dim1]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
|
||||
z__1.i = alpha->r * z__2.i + alpha->i *
|
||||
z__2.r;
|
||||
@ -511,7 +511,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,
|
||||
z__2.i = alpha->r * a[i__3].i + alpha->i * a[
|
||||
i__3].r;
|
||||
d_cnjg(&z__1, &z__2);
|
||||
d_lmp_cnjg(&z__1, &z__2);
|
||||
temp2.r = z__1.r, temp2.i = z__1.i;
|
||||
i__3 = *n;
|
||||
for (i__ = j + 1; i__ <= i__3; ++i__) {
|
||||
@ -565,14 +565,14 @@ extern "C" {
|
||||
temp2.r = 0., temp2.i = 0.;
|
||||
i__3 = *k;
|
||||
for (l = 1; l <= i__3; ++l) {
|
||||
d_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
i__4 = l + j * b_dim1;
|
||||
z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
|
||||
z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
|
||||
.r;
|
||||
z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
|
||||
temp1.r = z__1.r, temp1.i = z__1.i;
|
||||
d_cnjg(&z__3, &b[l + i__ * b_dim1]);
|
||||
d_lmp_cnjg(&z__3, &b[l + i__ * b_dim1]);
|
||||
i__4 = l + j * a_dim1;
|
||||
z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
|
||||
z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
|
||||
@ -587,7 +587,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
|
||||
z__2.i = alpha->r * temp1.i + alpha->i *
|
||||
temp1.r;
|
||||
d_cnjg(&z__4, alpha);
|
||||
d_lmp_cnjg(&z__4, alpha);
|
||||
z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
|
||||
z__3.i = z__4.r * temp2.i + z__4.i *
|
||||
temp2.r;
|
||||
@ -601,7 +601,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
|
||||
z__2.i = alpha->r * temp1.i + alpha->i *
|
||||
temp1.r;
|
||||
d_cnjg(&z__4, alpha);
|
||||
d_lmp_cnjg(&z__4, alpha);
|
||||
z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
|
||||
z__3.i = z__4.r * temp2.i + z__4.i *
|
||||
temp2.r;
|
||||
@ -616,7 +616,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
|
||||
z__2.i = alpha->r * temp1.i + alpha->i *
|
||||
temp1.r;
|
||||
d_cnjg(&z__4, alpha);
|
||||
d_lmp_cnjg(&z__4, alpha);
|
||||
z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
|
||||
z__3.i = z__4.r * temp2.i + z__4.i *
|
||||
temp2.r;
|
||||
@ -633,7 +633,7 @@ extern "C" {
|
||||
temp1.r;
|
||||
z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +
|
||||
z__4.i;
|
||||
d_cnjg(&z__6, alpha);
|
||||
d_lmp_cnjg(&z__6, alpha);
|
||||
z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,
|
||||
z__5.i = z__6.r * temp2.i + z__6.i *
|
||||
temp2.r;
|
||||
@ -655,14 +655,14 @@ extern "C" {
|
||||
temp2.r = 0., temp2.i = 0.;
|
||||
i__3 = *k;
|
||||
for (l = 1; l <= i__3; ++l) {
|
||||
d_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[l + i__ * a_dim1]);
|
||||
i__4 = l + j * b_dim1;
|
||||
z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
|
||||
z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
|
||||
.r;
|
||||
z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
|
||||
temp1.r = z__1.r, temp1.i = z__1.i;
|
||||
d_cnjg(&z__3, &b[l + i__ * b_dim1]);
|
||||
d_lmp_cnjg(&z__3, &b[l + i__ * b_dim1]);
|
||||
i__4 = l + j * a_dim1;
|
||||
z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
|
||||
z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
|
||||
@ -677,7 +677,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
|
||||
z__2.i = alpha->r * temp1.i + alpha->i *
|
||||
temp1.r;
|
||||
d_cnjg(&z__4, alpha);
|
||||
d_lmp_cnjg(&z__4, alpha);
|
||||
z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
|
||||
z__3.i = z__4.r * temp2.i + z__4.i *
|
||||
temp2.r;
|
||||
@ -691,7 +691,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
|
||||
z__2.i = alpha->r * temp1.i + alpha->i *
|
||||
temp1.r;
|
||||
d_cnjg(&z__4, alpha);
|
||||
d_lmp_cnjg(&z__4, alpha);
|
||||
z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
|
||||
z__3.i = z__4.r * temp2.i + z__4.i *
|
||||
temp2.r;
|
||||
@ -706,7 +706,7 @@ extern "C" {
|
||||
z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
|
||||
z__2.i = alpha->r * temp1.i + alpha->i *
|
||||
temp1.r;
|
||||
d_cnjg(&z__4, alpha);
|
||||
d_lmp_cnjg(&z__4, alpha);
|
||||
z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
|
||||
z__3.i = z__4.r * temp2.i + z__4.i *
|
||||
temp2.r;
|
||||
@ -723,7 +723,7 @@ extern "C" {
|
||||
temp1.r;
|
||||
z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +
|
||||
z__4.i;
|
||||
d_cnjg(&z__6, alpha);
|
||||
d_lmp_cnjg(&z__6, alpha);
|
||||
z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,
|
||||
z__5.i = z__6.r * temp2.i + z__6.i *
|
||||
temp2.r;
|
||||
|
||||
@ -152,7 +152,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, k, kk, ix, jx, kx, info;
|
||||
@ -231,7 +231,7 @@ extern "C" {
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = j;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0.) {
|
||||
d_cnjg(&z__2, &x[j]);
|
||||
d_lmp_cnjg(&z__2, &x[j]);
|
||||
z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
k = kk;
|
||||
@ -271,7 +271,7 @@ extern "C" {
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = jx;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0.) {
|
||||
d_cnjg(&z__2, &x[jx]);
|
||||
d_lmp_cnjg(&z__2, &x[jx]);
|
||||
z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
ix = kx;
|
||||
@ -316,7 +316,7 @@ extern "C" {
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = j;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0.) {
|
||||
d_cnjg(&z__2, &x[j]);
|
||||
d_lmp_cnjg(&z__2, &x[j]);
|
||||
z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
i__2 = kk;
|
||||
@ -356,7 +356,7 @@ extern "C" {
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = jx;
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0.) {
|
||||
d_cnjg(&z__2, &x[jx]);
|
||||
d_lmp_cnjg(&z__2, &x[jx]);
|
||||
z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
i__2 = kk;
|
||||
|
||||
@ -97,7 +97,7 @@ f"> */
|
||||
doublecomplex z__1;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, ioff;
|
||||
@ -128,7 +128,7 @@ f"> */
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
i__2 = i__;
|
||||
d_cnjg(&z__1, &x[i__]);
|
||||
d_lmp_cnjg(&z__1, &x[i__]);
|
||||
x[i__2].r = z__1.r, x[i__2].i = z__1.i;
|
||||
/* L10: */
|
||||
}
|
||||
@ -140,7 +140,7 @@ f"> */
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
i__2 = ioff;
|
||||
d_cnjg(&z__1, &x[ioff]);
|
||||
d_lmp_cnjg(&z__1, &x[ioff]);
|
||||
x[i__2].r = z__1.r, x[i__2].i = z__1.i;
|
||||
ioff += *incx;
|
||||
/* L20: */
|
||||
|
||||
@ -146,7 +146,7 @@ f"> */
|
||||
doublecomplex z__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_imag(doublecomplex *);
|
||||
double d_lmp_imag(doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, l;
|
||||
@ -225,7 +225,7 @@ f"> */
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
rwork[(j - 1) * *m + i__] = d_imag(&a[i__ + j * a_dim1]);
|
||||
rwork[(j - 1) * *m + i__] = d_lmp_imag(&a[i__ + j * a_dim1]);
|
||||
/* L50: */
|
||||
}
|
||||
/* L60: */
|
||||
|
||||
@ -88,7 +88,7 @@ f"> */
|
||||
doublecomplex z__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_imag(doublecomplex *);
|
||||
double d_lmp_imag(doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
doublereal zi, zr;
|
||||
@ -114,9 +114,9 @@ f"> */
|
||||
/* .. Executable Statements .. */
|
||||
|
||||
d__1 = x->r;
|
||||
d__2 = d_imag(x);
|
||||
d__2 = d_lmp_imag(x);
|
||||
d__3 = y->r;
|
||||
d__4 = d_imag(y);
|
||||
d__4 = d_lmp_imag(y);
|
||||
dladiv_(&d__1, &d__2, &d__3, &d__4, &zr, &zi);
|
||||
z__1.r = zr, z__1.i = zi;
|
||||
ret_val->r = z__1.r, ret_val->i = z__1.i;
|
||||
|
||||
@ -178,7 +178,7 @@ f"> */
|
||||
|
||||
/* Builtin functions */
|
||||
double log(doublereal);
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, k, ll, iq, lgn, msd2, smm1, spm1, spm2;
|
||||
@ -321,10 +321,10 @@ L10:
|
||||
|
||||
temp = log((doublereal) (*n)) / log(2.);
|
||||
lgn = (integer) temp;
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
iprmpt = indxq + *n + 1;
|
||||
|
||||
@ -280,7 +280,7 @@ f"> */
|
||||
integer q_dim1, q_offset, i__1, i__2;
|
||||
|
||||
/* Builtin functions */
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, k, n1, n2, iq, iw, iz, ptr, indx, curr, indxc, indxp;
|
||||
@ -386,11 +386,11 @@ f"> */
|
||||
/* Form the z-vector which consists of the last row of Q_1 and the */
|
||||
/* first row of Q_2. */
|
||||
|
||||
ptr = pow_ii(&c__2, tlvls) + 1;
|
||||
ptr = pow_lmp_ii(&c__2, tlvls) + 1;
|
||||
i__1 = *curlvl - 1;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
i__2 = *tlvls - i__;
|
||||
ptr += pow_ii(&c__2, &i__2);
|
||||
ptr += pow_lmp_ii(&c__2, &i__2);
|
||||
/* L10: */
|
||||
}
|
||||
curr = ptr + *curpbm;
|
||||
|
||||
@ -153,7 +153,7 @@ doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a,
|
||||
doublereal ret_val, d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double z_abs(doublecomplex *), sqrt(doublereal);
|
||||
double z_lmp_abs(doublecomplex *), sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j;
|
||||
@ -207,7 +207,7 @@ doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a,
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = j - 1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum = z_abs(&a[i__ + j * a_dim1]);
|
||||
sum = z_lmp_abs(&a[i__ + j * a_dim1]);
|
||||
if (value < sum || disnan_(&sum)) {
|
||||
value = sum;
|
||||
}
|
||||
@ -230,7 +230,7 @@ doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a,
|
||||
}
|
||||
i__2 = *n;
|
||||
for (i__ = j + 1; i__ <= i__2; ++i__) {
|
||||
sum = z_abs(&a[i__ + j * a_dim1]);
|
||||
sum = z_lmp_abs(&a[i__ + j * a_dim1]);
|
||||
if (value < sum || disnan_(&sum)) {
|
||||
value = sum;
|
||||
}
|
||||
@ -251,7 +251,7 @@ doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a,
|
||||
sum = 0.;
|
||||
i__2 = j - 1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
absa = z_abs(&a[i__ + j * a_dim1]);
|
||||
absa = z_lmp_abs(&a[i__ + j * a_dim1]);
|
||||
sum += absa;
|
||||
work[i__] += absa;
|
||||
/* L50: */
|
||||
@ -280,7 +280,7 @@ doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a,
|
||||
sum = work[j] + (d__1 = a[i__2].r, abs(d__1));
|
||||
i__2 = *n;
|
||||
for (i__ = j + 1; i__ <= i__2; ++i__) {
|
||||
absa = z_abs(&a[i__ + j * a_dim1]);
|
||||
absa = z_lmp_abs(&a[i__ + j * a_dim1]);
|
||||
sum += absa;
|
||||
work[i__] += absa;
|
||||
/* L90: */
|
||||
|
||||
@ -229,7 +229,7 @@ f"> */
|
||||
doublecomplex z__1, z__2;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j;
|
||||
@ -371,7 +371,7 @@ f"> */
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
i__3 = j + i__ * c_dim1;
|
||||
i__4 = j + i__ * c_dim1;
|
||||
d_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
d_lmp_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
|
||||
z__2.i;
|
||||
c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
|
||||
@ -529,7 +529,7 @@ f"> */
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
i__3 = *m - *k + j + i__ * c_dim1;
|
||||
i__4 = *m - *k + j + i__ * c_dim1;
|
||||
d_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
d_lmp_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
|
||||
z__2.i;
|
||||
c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
|
||||
@ -689,7 +689,7 @@ f"> */
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
i__3 = j + i__ * c_dim1;
|
||||
i__4 = j + i__ * c_dim1;
|
||||
d_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
d_lmp_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
|
||||
z__2.i;
|
||||
c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
|
||||
@ -848,7 +848,7 @@ f"> */
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
i__3 = *m - *k + j + i__ * c_dim1;
|
||||
i__4 = *m - *k + j + i__ * c_dim1;
|
||||
d_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
d_lmp_cnjg(&z__2, &work[i__ + j * work_dim1]);
|
||||
z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
|
||||
z__2.i;
|
||||
c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
|
||||
|
||||
@ -135,7 +135,7 @@ f"> */
|
||||
doublecomplex z__1, z__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_imag(doublecomplex *), d_sign(doublereal *, doublereal *);
|
||||
double d_lmp_imag(doublecomplex *), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
integer j, knt;
|
||||
@ -189,7 +189,7 @@ f"> */
|
||||
i__1 = *n - 1;
|
||||
xnorm = dznrm2_(&i__1, &x[1], incx);
|
||||
alphr = alpha->r;
|
||||
alphi = d_imag(alpha);
|
||||
alphi = d_lmp_imag(alpha);
|
||||
|
||||
if (xnorm == 0. && alphi == 0.) {
|
||||
|
||||
@ -201,7 +201,7 @@ f"> */
|
||||
/* general case */
|
||||
|
||||
d__1 = dlapy3_(&alphr, &alphi, &xnorm);
|
||||
beta = -d_sign(&d__1, &alphr);
|
||||
beta = -d_lmp_sign(&d__1, &alphr);
|
||||
safmin = dlamch_((char *)"S", (ftnlen)1) / dlamch_((char *)"E", (ftnlen)1);
|
||||
rsafmn = 1. / safmin;
|
||||
|
||||
@ -228,7 +228,7 @@ L10:
|
||||
z__1.r = alphr, z__1.i = alphi;
|
||||
alpha->r = z__1.r, alpha->i = z__1.i;
|
||||
d__1 = dlapy3_(&alphr, &alphi, &xnorm);
|
||||
beta = -d_sign(&d__1, &alphr);
|
||||
beta = -d_lmp_sign(&d__1, &alphr);
|
||||
}
|
||||
d__1 = (beta - alphr) / beta;
|
||||
d__2 = -alphi / beta;
|
||||
|
||||
@ -193,7 +193,7 @@ f"> */
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, prevlastv;
|
||||
@ -281,7 +281,7 @@ L220:
|
||||
i__3 = j + i__ * t_dim1;
|
||||
i__4 = i__;
|
||||
z__2.r = -tau[i__4].r, z__2.i = -tau[i__4].i;
|
||||
d_cnjg(&z__3, &v[i__ + j * v_dim1]);
|
||||
d_lmp_cnjg(&z__3, &v[i__ + j * v_dim1]);
|
||||
z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i =
|
||||
z__2.r * z__3.i + z__2.i * z__3.r;
|
||||
t[i__3].r = z__1.r, t[i__3].i = z__1.i;
|
||||
@ -382,7 +382,7 @@ L281:
|
||||
i__2 = j + i__ * t_dim1;
|
||||
i__3 = i__;
|
||||
z__2.r = -tau[i__3].r, z__2.i = -tau[i__3].i;
|
||||
d_cnjg(&z__3, &v[*n - *k + i__ + j * v_dim1]);
|
||||
d_lmp_cnjg(&z__3, &v[*n - *k + i__ + j * v_dim1]);
|
||||
z__1.r = z__2.r * z__3.r - z__2.i * z__3.i,
|
||||
z__1.i = z__2.r * z__3.i + z__2.i *
|
||||
z__3.r;
|
||||
|
||||
@ -132,7 +132,7 @@ f"> */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double d_imag(doublecomplex *);
|
||||
double d_lmp_imag(doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer ix;
|
||||
@ -184,7 +184,7 @@ f"> */
|
||||
*sumsq += d__1 * d__1;
|
||||
}
|
||||
}
|
||||
temp1 = (d__1 = d_imag(&x[ix]), abs(d__1));
|
||||
temp1 = (d__1 = d_lmp_imag(&x[ix]), abs(d__1));
|
||||
if (temp1 > 0. || disnan_(&temp1)) {
|
||||
if (*scale < temp1) {
|
||||
/* Computing 2nd power */
|
||||
|
||||
@ -247,7 +247,7 @@ f"> */
|
||||
|
||||
/* Builtin functions */
|
||||
double log(doublereal);
|
||||
integer pow_ii(integer *, integer *);
|
||||
integer pow_lmp_ii(integer *, integer *);
|
||||
double sqrt(doublereal);
|
||||
|
||||
/* Local variables */
|
||||
@ -365,10 +365,10 @@ f"> */
|
||||
lrwmin = *n - 1 << 1;
|
||||
} else if (icompz == 1) {
|
||||
lgn = (integer) (log((doublereal) (*n)) / log(2.));
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
if (pow_ii(&c__2, &lgn) < *n) {
|
||||
if (pow_lmp_ii(&c__2, &lgn) < *n) {
|
||||
++lgn;
|
||||
}
|
||||
lwmin = *n * *n;
|
||||
|
||||
@ -166,7 +166,7 @@ f"> */
|
||||
doublereal d__1, d__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
doublereal b, c__, f, g;
|
||||
@ -445,7 +445,7 @@ L60:
|
||||
|
||||
g = (d__[l + 1] - p) / (e[l] * 2.);
|
||||
r__ = dlapy2_(&g, &c_b41);
|
||||
g = d__[m] - p + e[l] / (g + d_sign(&r__, &g));
|
||||
g = d__[m] - p + e[l] / (g + d_lmp_sign(&r__, &g));
|
||||
|
||||
s = 1.;
|
||||
c__ = 1.;
|
||||
@ -568,7 +568,7 @@ L110:
|
||||
|
||||
g = (d__[l - 1] - p) / (e[l - 1] * 2.);
|
||||
r__ = dlapy2_(&g, &c_b41);
|
||||
g = d__[m] - p + e[l - 1] / (g + d_sign(&r__, &g));
|
||||
g = d__[m] - p + e[l - 1] / (g + d_lmp_sign(&r__, &g));
|
||||
|
||||
s = 1.;
|
||||
c__ = 1.;
|
||||
|
||||
@ -164,7 +164,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, k, kk, ix, jx, kx, info;
|
||||
@ -432,14 +432,14 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk]);
|
||||
d_lmp_cnjg(&z__2, &ap[kk]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
for (i__ = j - 1; i__ >= 1; --i__) {
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__1 = i__;
|
||||
z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
|
||||
z__2.i = z__3.r * x[i__1].i + z__3.i * x[
|
||||
@ -485,7 +485,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk]);
|
||||
d_lmp_cnjg(&z__2, &ap[kk]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -494,7 +494,7 @@ extern "C" {
|
||||
i__1 = kk - j + 1;
|
||||
for (k = kk - 1; k >= i__1; --k) {
|
||||
ix -= *incx;
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__2 = ix;
|
||||
z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,
|
||||
z__2.i = z__3.r * x[i__2].i + z__3.i * x[
|
||||
@ -543,7 +543,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk]);
|
||||
d_lmp_cnjg(&z__2, &ap[kk]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -551,7 +551,7 @@ extern "C" {
|
||||
}
|
||||
i__2 = *n;
|
||||
for (i__ = j + 1; i__ <= i__2; ++i__) {
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__3 = i__;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[
|
||||
@ -598,7 +598,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk]);
|
||||
d_lmp_cnjg(&z__2, &ap[kk]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -607,7 +607,7 @@ extern "C" {
|
||||
i__2 = kk + *n - j;
|
||||
for (k = kk + 1; k <= i__2; ++k) {
|
||||
ix += *incx;
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__3 = ix;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[
|
||||
|
||||
@ -166,7 +166,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
/* Builtin functions */
|
||||
void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
|
||||
void z_lmp_div(doublecomplex *, doublecomplex *, doublecomplex *), d_lmp_cnjg(
|
||||
doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
@ -260,7 +260,7 @@ extern "C" {
|
||||
if (x[i__1].r != 0. || x[i__1].i != 0.) {
|
||||
if (nounit) {
|
||||
i__1 = j;
|
||||
z_div(&z__1, &x[j], &ap[kk]);
|
||||
z_lmp_div(&z__1, &x[j], &ap[kk]);
|
||||
x[i__1].r = z__1.r, x[i__1].i = z__1.i;
|
||||
}
|
||||
i__1 = j;
|
||||
@ -290,7 +290,7 @@ extern "C" {
|
||||
if (x[i__1].r != 0. || x[i__1].i != 0.) {
|
||||
if (nounit) {
|
||||
i__1 = jx;
|
||||
z_div(&z__1, &x[jx], &ap[kk]);
|
||||
z_lmp_div(&z__1, &x[jx], &ap[kk]);
|
||||
x[i__1].r = z__1.r, x[i__1].i = z__1.i;
|
||||
}
|
||||
i__1 = jx;
|
||||
@ -325,7 +325,7 @@ extern "C" {
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0.) {
|
||||
if (nounit) {
|
||||
i__2 = j;
|
||||
z_div(&z__1, &x[j], &ap[kk]);
|
||||
z_lmp_div(&z__1, &x[j], &ap[kk]);
|
||||
x[i__2].r = z__1.r, x[i__2].i = z__1.i;
|
||||
}
|
||||
i__2 = j;
|
||||
@ -357,7 +357,7 @@ extern "C" {
|
||||
if (x[i__2].r != 0. || x[i__2].i != 0.) {
|
||||
if (nounit) {
|
||||
i__2 = jx;
|
||||
z_div(&z__1, &x[jx], &ap[kk]);
|
||||
z_lmp_div(&z__1, &x[jx], &ap[kk]);
|
||||
x[i__2].r = z__1.r, x[i__2].i = z__1.i;
|
||||
}
|
||||
i__2 = jx;
|
||||
@ -411,13 +411,13 @@ extern "C" {
|
||||
/* L90: */
|
||||
}
|
||||
if (nounit) {
|
||||
z_div(&z__1, &temp, &ap[kk + j - 1]);
|
||||
z_lmp_div(&z__1, &temp, &ap[kk + j - 1]);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
} else {
|
||||
i__2 = j - 1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__3 = i__;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[
|
||||
@ -429,8 +429,8 @@ extern "C" {
|
||||
/* L100: */
|
||||
}
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk + j - 1]);
|
||||
z_div(&z__1, &temp, &z__2);
|
||||
d_lmp_cnjg(&z__2, &ap[kk + j - 1]);
|
||||
z_lmp_div(&z__1, &temp, &z__2);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
}
|
||||
@ -461,13 +461,13 @@ extern "C" {
|
||||
/* L120: */
|
||||
}
|
||||
if (nounit) {
|
||||
z_div(&z__1, &temp, &ap[kk + j - 1]);
|
||||
z_lmp_div(&z__1, &temp, &ap[kk + j - 1]);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
} else {
|
||||
i__2 = kk + j - 2;
|
||||
for (k = kk; k <= i__2; ++k) {
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__3 = ix;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[
|
||||
@ -479,8 +479,8 @@ extern "C" {
|
||||
/* L130: */
|
||||
}
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk + j - 1]);
|
||||
z_div(&z__1, &temp, &z__2);
|
||||
d_lmp_cnjg(&z__2, &ap[kk + j - 1]);
|
||||
z_lmp_div(&z__1, &temp, &z__2);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
}
|
||||
@ -513,13 +513,13 @@ extern "C" {
|
||||
/* L150: */
|
||||
}
|
||||
if (nounit) {
|
||||
z_div(&z__1, &temp, &ap[kk - *n + j]);
|
||||
z_lmp_div(&z__1, &temp, &ap[kk - *n + j]);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
} else {
|
||||
i__1 = j + 1;
|
||||
for (i__ = *n; i__ >= i__1; --i__) {
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__2 = i__;
|
||||
z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,
|
||||
z__2.i = z__3.r * x[i__2].i + z__3.i * x[
|
||||
@ -531,8 +531,8 @@ extern "C" {
|
||||
/* L160: */
|
||||
}
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk - *n + j]);
|
||||
z_div(&z__1, &temp, &z__2);
|
||||
d_lmp_cnjg(&z__2, &ap[kk - *n + j]);
|
||||
z_lmp_div(&z__1, &temp, &z__2);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
}
|
||||
@ -563,13 +563,13 @@ extern "C" {
|
||||
/* L180: */
|
||||
}
|
||||
if (nounit) {
|
||||
z_div(&z__1, &temp, &ap[kk - *n + j]);
|
||||
z_lmp_div(&z__1, &temp, &ap[kk - *n + j]);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
} else {
|
||||
i__1 = kk - (*n - (j + 1));
|
||||
for (k = kk; k >= i__1; --k) {
|
||||
d_cnjg(&z__3, &ap[k]);
|
||||
d_lmp_cnjg(&z__3, &ap[k]);
|
||||
i__2 = ix;
|
||||
z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,
|
||||
z__2.i = z__3.r * x[i__2].i + z__3.i * x[
|
||||
@ -581,8 +581,8 @@ extern "C" {
|
||||
/* L190: */
|
||||
}
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &ap[kk - *n + j]);
|
||||
z_div(&z__1, &temp, &z__2);
|
||||
d_lmp_cnjg(&z__2, &ap[kk - *n + j]);
|
||||
z_lmp_div(&z__1, &temp, &z__2);
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
}
|
||||
|
||||
@ -146,7 +146,7 @@ f"> */
|
||||
doublecomplex z__1;
|
||||
|
||||
/* Builtin functions */
|
||||
void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
|
||||
void z_lmp_div(doublecomplex *, doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer j, jc, jj;
|
||||
@ -243,7 +243,7 @@ f"> */
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (nounit) {
|
||||
i__2 = jc + j - 1;
|
||||
z_div(&z__1, &c_b1, &ap[jc + j - 1]);
|
||||
z_lmp_div(&z__1, &c_b1, &ap[jc + j - 1]);
|
||||
ap[i__2].r = z__1.r, ap[i__2].i = z__1.i;
|
||||
i__2 = jc + j - 1;
|
||||
z__1.r = -ap[i__2].r, z__1.i = -ap[i__2].i;
|
||||
@ -272,7 +272,7 @@ f"> */
|
||||
for (j = *n; j >= 1; --j) {
|
||||
if (nounit) {
|
||||
i__1 = jc;
|
||||
z_div(&z__1, &c_b1, &ap[jc]);
|
||||
z_lmp_div(&z__1, &c_b1, &ap[jc]);
|
||||
ap[i__1].r = z__1.r, ap[i__1].i = z__1.i;
|
||||
i__1 = jc;
|
||||
z__1.r = -ap[i__1].r, z__1.i = -ap[i__1].i;
|
||||
|
||||
@ -201,7 +201,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, k, info;
|
||||
@ -424,7 +424,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -432,7 +432,7 @@ extern "C" {
|
||||
}
|
||||
i__2 = i__ - 1;
|
||||
for (k = 1; k <= i__2; ++k) {
|
||||
d_cnjg(&z__3, &a[k + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[k + i__ * a_dim1]);
|
||||
i__3 = k + j * b_dim1;
|
||||
z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
|
||||
.i, z__2.i = z__3.r * b[i__3].i +
|
||||
@ -481,7 +481,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -489,7 +489,7 @@ extern "C" {
|
||||
}
|
||||
i__3 = *m;
|
||||
for (k = i__ + 1; k <= i__3; ++k) {
|
||||
d_cnjg(&z__3, &a[k + i__ * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[k + i__ * a_dim1]);
|
||||
i__4 = k + j * b_dim1;
|
||||
z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
|
||||
.i, z__2.i = z__3.r * b[i__4].i +
|
||||
@ -630,7 +630,7 @@ extern "C" {
|
||||
.i + alpha->i * a[i__3].r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
} else {
|
||||
d_cnjg(&z__2, &a[j + k * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[j + k * a_dim1]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i *
|
||||
z__2.i, z__1.i = alpha->r * z__2.i +
|
||||
alpha->i * z__2.r;
|
||||
@ -661,7 +661,7 @@ extern "C" {
|
||||
i__2].r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
} else {
|
||||
d_cnjg(&z__2, &a[k + k * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[k + k * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -695,7 +695,7 @@ extern "C" {
|
||||
.i + alpha->i * a[i__2].r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
} else {
|
||||
d_cnjg(&z__2, &a[j + k * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[j + k * a_dim1]);
|
||||
z__1.r = alpha->r * z__2.r - alpha->i *
|
||||
z__2.i, z__1.i = alpha->r * z__2.i +
|
||||
alpha->i * z__2.r;
|
||||
@ -726,7 +726,7 @@ extern "C" {
|
||||
i__1].r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
} else {
|
||||
d_cnjg(&z__2, &a[k + k * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[k + k * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
|
||||
@ -169,7 +169,7 @@ extern "C" {
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, ix, jx, kx, info;
|
||||
@ -428,14 +428,14 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
temp.r = z__1.r, temp.i = z__1.i;
|
||||
}
|
||||
for (i__ = j - 1; i__ >= 1; --i__) {
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__1 = i__;
|
||||
z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
|
||||
z__2.i = z__3.r * x[i__1].i + z__3.i * x[
|
||||
@ -478,7 +478,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -486,7 +486,7 @@ extern "C" {
|
||||
}
|
||||
for (i__ = j - 1; i__ >= 1; --i__) {
|
||||
ix -= *incx;
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__1 = ix;
|
||||
z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
|
||||
z__2.i = z__3.r * x[i__1].i + z__3.i * x[
|
||||
@ -531,7 +531,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -539,7 +539,7 @@ extern "C" {
|
||||
}
|
||||
i__2 = *n;
|
||||
for (i__ = j + 1; i__ <= i__2; ++i__) {
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = i__;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[
|
||||
@ -584,7 +584,7 @@ extern "C" {
|
||||
}
|
||||
} else {
|
||||
if (nounit) {
|
||||
d_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__2, &a[j + j * a_dim1]);
|
||||
z__1.r = temp.r * z__2.r - temp.i * z__2.i,
|
||||
z__1.i = temp.r * z__2.i + temp.i *
|
||||
z__2.r;
|
||||
@ -593,7 +593,7 @@ extern "C" {
|
||||
i__2 = *n;
|
||||
for (i__ = j + 1; i__ <= i__2; ++i__) {
|
||||
ix += *incx;
|
||||
d_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
d_lmp_cnjg(&z__3, &a[i__ + j * a_dim1]);
|
||||
i__3 = ix;
|
||||
z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
|
||||
z__2.i = z__3.r * x[i__3].i + z__3.i * x[
|
||||
|
||||
@ -139,7 +139,7 @@ f"> */
|
||||
doublecomplex z__1, z__2;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, j, l;
|
||||
@ -235,7 +235,7 @@ f"> */
|
||||
a[i__1].r = 1., a[i__1].i = 0.;
|
||||
i__1 = *m - i__;
|
||||
i__2 = *n - i__ + 1;
|
||||
d_cnjg(&z__1, &tau[i__]);
|
||||
d_lmp_cnjg(&z__1, &tau[i__]);
|
||||
zlarf_((char *)"Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &
|
||||
z__1, &a[i__ + 1 + i__ * a_dim1], lda, &work[1], (
|
||||
ftnlen)5);
|
||||
@ -248,7 +248,7 @@ f"> */
|
||||
zlacgv_(&i__1, &a[i__ + (i__ + 1) * a_dim1], lda);
|
||||
}
|
||||
i__1 = i__ + i__ * a_dim1;
|
||||
d_cnjg(&z__2, &tau[i__]);
|
||||
d_lmp_cnjg(&z__2, &tau[i__]);
|
||||
z__1.r = 1. - z__2.r, z__1.i = 0. - z__2.i;
|
||||
a[i__1].r = z__1.r, a[i__1].i = z__1.i;
|
||||
|
||||
|
||||
@ -189,7 +189,7 @@ f"> */
|
||||
doublecomplex z__1;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, i1, i2, i3, mi, ni, nq;
|
||||
@ -315,7 +315,7 @@ f"> */
|
||||
i__3 = i__;
|
||||
taui.r = tau[i__3].r, taui.i = tau[i__3].i;
|
||||
} else {
|
||||
d_cnjg(&z__1, &tau[i__]);
|
||||
d_lmp_cnjg(&z__1, &tau[i__]);
|
||||
taui.r = z__1.r, taui.i = z__1.i;
|
||||
}
|
||||
i__3 = nq - *k + i__ + i__ * a_dim1;
|
||||
|
||||
@ -189,7 +189,7 @@ f"> */
|
||||
doublecomplex z__1;
|
||||
|
||||
/* Builtin functions */
|
||||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
void d_lmp_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
|
||||
@ -319,7 +319,7 @@ f"> */
|
||||
i__3 = i__;
|
||||
taui.r = tau[i__3].r, taui.i = tau[i__3].i;
|
||||
} else {
|
||||
d_cnjg(&z__1, &tau[i__]);
|
||||
d_lmp_cnjg(&z__1, &tau[i__]);
|
||||
taui.r = z__1.r, taui.i = z__1.i;
|
||||
}
|
||||
i__3 = i__ + i__ * a_dim1;
|
||||
|
||||
@ -201,7 +201,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, i1, i2, i3, ib, nb, mi, ni, nq, nw, iwt;
|
||||
@ -306,7 +306,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"ZUNMQL", ch__1, m, n, k, &c_n1,
|
||||
(ftnlen)6, (ftnlen)2);
|
||||
nb = min(i__1,i__2);
|
||||
@ -338,7 +338,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 2, i__2 = ilaenv_(&c__2, (char *)"ZUNMQL", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nbmin = max(i__1,i__2);
|
||||
|
||||
@ -201,7 +201,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i__, i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iwt;
|
||||
@ -303,7 +303,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"ZUNMQR", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nb = min(i__1,i__2);
|
||||
@ -335,7 +335,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__3[0] = 1, a__1[0] = side;
|
||||
i__3[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
|
||||
i__1 = 2, i__2 = ilaenv_(&c__2, (char *)"ZUNMQR", ch__1, m, n, k, &c_n1, (
|
||||
ftnlen)6, (ftnlen)2);
|
||||
nbmin = max(i__1,i__2);
|
||||
|
||||
@ -203,7 +203,7 @@ f"> */
|
||||
char ch__1[2];
|
||||
|
||||
/* Builtin functions */
|
||||
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
/* Subroutine */ int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
|
||||
|
||||
/* Local variables */
|
||||
integer i1, i2, nb, mi, ni, nq, nw;
|
||||
@ -298,7 +298,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *m - 1;
|
||||
i__3 = *m - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"ZUNMQL", ch__1, &i__2, n, &i__3, &c_n1, (
|
||||
@ -307,7 +307,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *n - 1;
|
||||
i__3 = *n - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"ZUNMQL", ch__1, m, &i__2, &i__3, &c_n1, (
|
||||
@ -318,7 +318,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *m - 1;
|
||||
i__3 = *m - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"ZUNMQR", ch__1, &i__2, n, &i__3, &c_n1, (
|
||||
@ -327,7 +327,7 @@ f"> */
|
||||
/* Writing concatenation */
|
||||
i__1[0] = 1, a__1[0] = side;
|
||||
i__1[1] = 1, a__1[1] = trans;
|
||||
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
|
||||
i__2 = *n - 1;
|
||||
i__3 = *n - 1;
|
||||
nb = ilaenv_(&c__1, (char *)"ZUNMQR", ch__1, m, &i__2, &i__3, &c_n1, (
|
||||
|
||||
Reference in New Issue
Block a user