updated 3rd party libs: CLapack 3.1.1.1 => 3.2.1, zlib 1.2.3 => 1.2.5, libpng 1.2.x => 1.4.3, libtiff 3.7.x => 3.9.4. fixed many 64-bit related VS2010 warnings
This commit is contained in:
83
3rdparty/lapack/dlarf.c
vendored
83
3rdparty/lapack/dlarf.c
vendored
@@ -1,5 +1,18 @@
|
||||
/* dlarf.f -- translated by f2c (version 20061008).
|
||||
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
|
||||
*/
|
||||
|
||||
#include "clapack.h"
|
||||
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
static doublereal c_b4 = 1.;
|
||||
@@ -15,6 +28,8 @@ static integer c__1 = 1;
|
||||
doublereal d__1;
|
||||
|
||||
/* Local variables */
|
||||
integer i__;
|
||||
logical applyleft;
|
||||
extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
|
||||
doublereal *, integer *, doublereal *, integer *, doublereal *,
|
||||
integer *);
|
||||
@@ -22,9 +37,12 @@ static integer c__1 = 1;
|
||||
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
|
||||
doublereal *, doublereal *, integer *, doublereal *, integer *,
|
||||
doublereal *, doublereal *, integer *);
|
||||
integer lastc, lastv;
|
||||
extern integer iladlc_(integer *, integer *, doublereal *, integer *),
|
||||
iladlr_(integer *, integer *, doublereal *, integer *);
|
||||
|
||||
|
||||
/* -- LAPACK auxiliary routine (version 3.1) -- */
|
||||
/* -- LAPACK auxiliary routine (version 3.2) -- */
|
||||
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
|
||||
/* November 2006 */
|
||||
|
||||
@@ -86,6 +104,8 @@ static integer c__1 = 1;
|
||||
|
||||
/* .. Parameters .. */
|
||||
/* .. */
|
||||
/* .. Local Scalars .. */
|
||||
/* .. */
|
||||
/* .. External Subroutines .. */
|
||||
/* .. */
|
||||
/* .. External Functions .. */
|
||||
@@ -100,39 +120,70 @@ static integer c__1 = 1;
|
||||
--work;
|
||||
|
||||
/* Function Body */
|
||||
if (lsame_(side, "L")) {
|
||||
applyleft = lsame_(side, "L");
|
||||
lastv = 0;
|
||||
lastc = 0;
|
||||
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;
|
||||
}
|
||||
/* Look for the last non-zero row in V. */
|
||||
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 {
|
||||
/* Scan for the last non-zero row in C(:,1:lastv). */
|
||||
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. */
|
||||
if (applyleft) {
|
||||
|
||||
/* Form H * C */
|
||||
|
||||
if (*tau != 0.) {
|
||||
if (lastv > 0) {
|
||||
|
||||
/* w := C' * v */
|
||||
/* w(1:lastc,1) := C(1:lastv,1:lastc)' * v(1:lastv,1) */
|
||||
|
||||
dgemv_("Transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1], incv,
|
||||
&c_b5, &work[1], &c__1);
|
||||
dgemv_("Transpose", &lastv, &lastc, &c_b4, &c__[c_offset], ldc, &
|
||||
v[1], incv, &c_b5, &work[1], &c__1);
|
||||
|
||||
/* C := C - v * w' */
|
||||
/* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)' */
|
||||
|
||||
d__1 = -(*tau);
|
||||
dger_(m, n, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset],
|
||||
ldc);
|
||||
dger_(&lastv, &lastc, &d__1, &v[1], incv, &work[1], &c__1, &c__[
|
||||
c_offset], ldc);
|
||||
}
|
||||
} else {
|
||||
|
||||
/* Form C * H */
|
||||
|
||||
if (*tau != 0.) {
|
||||
if (lastv > 0) {
|
||||
|
||||
/* w := C * v */
|
||||
/* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) */
|
||||
|
||||
dgemv_("No transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1],
|
||||
incv, &c_b5, &work[1], &c__1);
|
||||
dgemv_("No transpose", &lastc, &lastv, &c_b4, &c__[c_offset], ldc,
|
||||
&v[1], incv, &c_b5, &work[1], &c__1);
|
||||
|
||||
/* C := C - w * v' */
|
||||
/* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)' */
|
||||
|
||||
d__1 = -(*tau);
|
||||
dger_(m, n, &d__1, &work[1], &c__1, &v[1], incv, &c__[c_offset],
|
||||
ldc);
|
||||
dger_(&lastc, &lastv, &d__1, &work[1], &c__1, &v[1], incv, &c__[
|
||||
c_offset], ldc);
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
Reference in New Issue
Block a user