whitespace fixes
This commit is contained in:
Axel Kohlmeyer
@ -1,13 +1,13 @@
|
||||
/* fortran/dlarf.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.,
|
||||
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
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
*/
|
||||
|
||||
#ifdef __cplusplus
|
||||
@ -147,8 +147,8 @@ static integer c__1 = 1;
|
||||
|
||||
/* ===================================================================== */
|
||||
/* Subroutine */ int dlarf_(char *side, integer *m, integer *n, doublereal *v,
|
||||
integer *incv, doublereal *tau, doublereal *c__, integer *ldc,
|
||||
doublereal *work, ftnlen side_len)
|
||||
integer *incv, doublereal *tau, doublereal *c__, integer *ldc,
|
||||
doublereal *work, ftnlen side_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer c_dim1, c_offset;
|
||||
@ -157,16 +157,16 @@ static integer c__1 = 1;
|
||||
/* Local variables */
|
||||
integer i__;
|
||||
logical applyleft;
|
||||
extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
|
||||
doublereal *, integer *, doublereal *, integer *, doublereal *,
|
||||
integer *);
|
||||
extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
|
||||
doublereal *, integer *, doublereal *, integer *, doublereal *,
|
||||
integer *);
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
|
||||
doublereal *, doublereal *, integer *, doublereal *, integer *,
|
||||
doublereal *, doublereal *, integer *, ftnlen);
|
||||
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
|
||||
doublereal *, doublereal *, integer *, doublereal *, integer *,
|
||||
doublereal *, doublereal *, integer *, ftnlen);
|
||||
integer lastc, lastv;
|
||||
extern integer iladlc_(integer *, integer *, doublereal *, integer *),
|
||||
iladlr_(integer *, integer *, doublereal *, integer *);
|
||||
extern integer iladlc_(integer *, integer *, doublereal *, integer *),
|
||||
iladlr_(integer *, integer *, doublereal *, integer *);
|
||||
|
||||
|
||||
/* -- LAPACK auxiliary routine -- */
|
||||
@ -204,28 +204,28 @@ static integer c__1 = 1;
|
||||
if (*tau != 0.) {
|
||||
/* Set up variables for scanning V. LASTV begins pointing to the end */
|
||||
/* of V. */
|
||||
if (applyleft) {
|
||||
lastv = *m;
|
||||
} else {
|
||||
lastv = *n;
|
||||
}
|
||||
if (*incv > 0) {
|
||||
i__ = (lastv - 1) * *incv + 1;
|
||||
} else {
|
||||
i__ = 1;
|
||||
}
|
||||
if (applyleft) {
|
||||
lastv = *m;
|
||||
} else {
|
||||
lastv = *n;
|
||||
}
|
||||
if (*incv > 0) {
|
||||
i__ = (lastv - 1) * *incv + 1;
|
||||
} else {
|
||||
i__ = 1;
|
||||
}
|
||||
/* Look for the last non-zero row in V. */
|
||||
while(lastv > 0 && v[i__] == 0.) {
|
||||
--lastv;
|
||||
i__ -= *incv;
|
||||
}
|
||||
if (applyleft) {
|
||||
while(lastv > 0 && v[i__] == 0.) {
|
||||
--lastv;
|
||||
i__ -= *incv;
|
||||
}
|
||||
if (applyleft) {
|
||||
/* Scan for the last non-zero column in C(1:lastv,:). */
|
||||
lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
|
||||
} else {
|
||||
lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
|
||||
} else {
|
||||
/* Scan for the last non-zero row in C(:,1:lastv). */
|
||||
lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
|
||||
}
|
||||
lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
|
||||
}
|
||||
}
|
||||
/* Note that lastc.eq.0 renders the BLAS operations null; no special */
|
||||
/* case is needed at this level. */
|
||||
@ -233,36 +233,36 @@ static integer c__1 = 1;
|
||||
|
||||
/* Form H * C */
|
||||
|
||||
if (lastv > 0) {
|
||||
if (lastv > 0) {
|
||||
|
||||
/* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) */
|
||||
|
||||
dgemv_((char *)"Transpose", &lastv, &lastc, &c_b4, &c__[c_offset], ldc, &
|
||||
v[1], incv, &c_b5, &work[1], &c__1, (ftnlen)9);
|
||||
dgemv_((char *)"Transpose", &lastv, &lastc, &c_b4, &c__[c_offset], ldc, &
|
||||
v[1], incv, &c_b5, &work[1], &c__1, (ftnlen)9);
|
||||
|
||||
/* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T */
|
||||
|
||||
d__1 = -(*tau);
|
||||
dger_(&lastv, &lastc, &d__1, &v[1], incv, &work[1], &c__1, &c__[
|
||||
c_offset], ldc);
|
||||
}
|
||||
d__1 = -(*tau);
|
||||
dger_(&lastv, &lastc, &d__1, &v[1], incv, &work[1], &c__1, &c__[
|
||||
c_offset], ldc);
|
||||
}
|
||||
} else {
|
||||
|
||||
/* Form C * H */
|
||||
|
||||
if (lastv > 0) {
|
||||
if (lastv > 0) {
|
||||
|
||||
/* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) */
|
||||
|
||||
dgemv_((char *)"No transpose", &lastc, &lastv, &c_b4, &c__[c_offset], ldc,
|
||||
&v[1], incv, &c_b5, &work[1], &c__1, (ftnlen)12);
|
||||
dgemv_((char *)"No transpose", &lastc, &lastv, &c_b4, &c__[c_offset], ldc,
|
||||
&v[1], incv, &c_b5, &work[1], &c__1, (ftnlen)12);
|
||||
|
||||
/* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T */
|
||||
|
||||
d__1 = -(*tau);
|
||||
dger_(&lastc, &lastv, &d__1, &work[1], &c__1, &v[1], incv, &c__[
|
||||
c_offset], ldc);
|
||||
}
|
||||
d__1 = -(*tau);
|
||||
dger_(&lastc, &lastv, &d__1, &work[1], &c__1, &v[1], incv, &c__[
|
||||
c_offset], ldc);
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
@ -271,5 +271,5 @@ static integer c__1 = 1;
|
||||
} /* dlarf_ */
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
Reference in New Issue
Block a user