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:
Vadim Pisarevsky
2010-07-16 12:54:53 +00:00
parent 0c9eca7922
commit f78a3b4cc1
465 changed files with 51856 additions and 41344 deletions

View File

@@ -1,5 +1,18 @@
/* dasum.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"
doublereal dasum_(integer *n, doublereal *dx, integer *incx)
{
/* System generated locals */

View File

@@ -1,5 +1,18 @@
/* daxpy.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"
/* Subroutine */ int daxpy_(integer *n, doublereal *da, doublereal *dx,
integer *incx, doublereal *dy, integer *incy)
{

View File

@@ -1,5 +1,18 @@
/* dbdsdc.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 integer c__9 = 9;
@@ -63,7 +76,7 @@ static doublereal c_b29 = 0.;
integer givnum, givptr, qstart, smlsiz, wstart, smlszp;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dbdsqr.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_b15 = -.125;
@@ -64,7 +77,7 @@ static doublereal c_b72 = -1.;
doublereal tolmul;
/* -- LAPACK routine (version 3.1.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* January 2007 */
@@ -164,16 +177,23 @@ static doublereal c_b72 = -1.;
/* The leading dimension of the array C. */
/* LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0. */
/* WORK (workspace) DOUBLE PRECISION array, dimension (2*N) */
/* if NCVT = NRU = NCC = 0, (max(1, 4*N)) otherwise */
/* WORK (workspace) DOUBLE PRECISION array, dimension (4*N) */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: If INFO = -i, the i-th argument had an illegal value */
/* > 0: the algorithm did not converge; D and E contain the */
/* elements of a bidiagonal matrix which is orthogonally */
/* similar to the input matrix B; if INFO = i, i */
/* elements of E have not converged to zero. */
/* > 0: */
/* if NCVT = NRU = NCC = 0, */
/* = 1, a split was marked by a positive value in E */
/* = 2, current block of Z not diagonalized after 30*N */
/* iterations (in inner while loop) */
/* = 3, termination criterion of outer while loop not met */
/* (program created more than N unreduced blocks) */
/* else NCVT = NRU = NCC = 0, */
/* the algorithm did not converge; D and E contain the */
/* elements of a bidiagonal matrix which is orthogonally */
/* similar to the input matrix B; if INFO = i, i */
/* elements of E have not converged to zero. */
/* Internal Parameters */
/* =================== */

View File

@@ -1,5 +1,18 @@
/* dcopy.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"
/* Subroutine */ int dcopy_(integer *n, doublereal *dx, integer *incx,
doublereal *dy, integer *incy)
{

View File

@@ -1,5 +1,18 @@
/* ddot.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"
doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,
integer *incy)
{

View File

@@ -1,5 +1,18 @@
/* dgebd2.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 integer c__1 = 1;
@@ -19,7 +32,7 @@ static integer c__1 = 1;
doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgebrd.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 integer c__1 = 1;
@@ -35,7 +48,7 @@ static doublereal c_b22 = 1.;
logical lquery;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgelq2.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"
/* Subroutine */ int dgelq2_(integer *m, integer *n, doublereal *a, integer *
lda, doublereal *tau, doublereal *work, integer *info)
{
@@ -11,11 +24,11 @@
doublereal aii;
extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, doublereal *, integer *,
doublereal *), dlarfg_(integer *, doublereal *,
doublereal *), dlarfp_(integer *, doublereal *,
doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -121,7 +134,7 @@
i__2 = *n - i__ + 1;
/* Computing MIN */
i__3 = i__ + 1;
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n)* a_dim1]
dlarfp_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n)* a_dim1]
, lda, &tau[i__]);
if (i__ < *m) {

View File

@@ -1,5 +1,18 @@
/* dgelqf.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 integer c__1 = 1;
@@ -27,7 +40,7 @@ static integer c__2 = 2;
logical lquery;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgels.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 integer c__1 = 1;
@@ -51,7 +64,7 @@ static integer c__0 = 0;
integer *);
/* -- LAPACK driver routine (version 3.1) -- */
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgelsd.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 integer c__6 = 6;
@@ -64,7 +77,7 @@ static doublereal c_b82 = 0.;
integer smlsiz;
/* -- LAPACK driver routine (version 3.1) -- */
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -336,6 +349,14 @@ static doublereal c_b82 = 0.;
/* Computing MAX */
i__1 = maxwrk, i__2 = *m * *m + (*m << 2) + wlalsd;
maxwrk = max(i__1,i__2);
/* XXX: Ensure the Path 2a case below is triggered. The workspace */
/* calculation should use queries for all routines eventually. */
/* Computing MAX */
/* Computing MAX */
i__3 = *m, i__4 = (*m << 1) - 4, i__3 = max(i__3,i__4), i__3 =
max(i__3,*nrhs), i__4 = *n - *m * 3;
i__1 = maxwrk, i__2 = (*m << 2) + *m * *m + max(i__3,i__4);
maxwrk = max(i__1,i__2);
} else {
/* Path 2 - remaining underdetermined cases. */

View File

@@ -1,5 +1,18 @@
/* dgemm.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"
/* Subroutine */ int dgemm_(char *transa, char *transb, integer *m, integer *
n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
doublereal *b, integer *ldb, doublereal *beta, doublereal *c__,

View File

@@ -1,5 +1,18 @@
/* dgemv.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"
/* Subroutine */ int dgemv_(char *trans, integer *m, integer *n, doublereal *
alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,
doublereal *beta, doublereal *y, integer *incy)

View File

@@ -1,5 +1,18 @@
/* dgeqr2.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 integer c__1 = 1;
@@ -15,11 +28,11 @@ static integer c__1 = 1;
doublereal aii;
extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, doublereal *, integer *,
doublereal *), dlarfg_(integer *, doublereal *,
doublereal *), dlarfp_(integer *, doublereal *,
doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -125,7 +138,7 @@ static integer c__1 = 1;
i__2 = *m - i__ + 1;
/* Computing MIN */
i__3 = i__ + 1;
dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m)+ i__ * a_dim1]
dlarfp_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m)+ i__ * a_dim1]
, &c__1, &tau[i__]);
if (i__ < *n) {

View File

@@ -1,5 +1,18 @@
/* dgeqrf.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 integer c__1 = 1;
@@ -27,7 +40,7 @@ static integer c__2 = 2;
logical lquery;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dger.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"
/* Subroutine */ int dger_(integer *m, integer *n, doublereal *alpha,
doublereal *x, integer *incx, doublereal *y, integer *incy,
doublereal *a, integer *lda)

View File

@@ -1,5 +1,18 @@
/* dgesdd.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 integer c__1 = 1;
@@ -68,9 +81,10 @@ static doublereal c_b248 = 1.;
logical wntqas, lquery;
/* -- LAPACK driver routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK driver routine (version 3.2.1) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* March 2009 */
/* .. Scalar Arguments .. */
/* .. */
@@ -179,10 +193,10 @@ static doublereal c_b248 = 1.;
/* If JOBZ = 'N', */
/* LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)). */
/* If JOBZ = 'O', */
/* LWORK >= 3*min(M,N)*min(M,N) + */
/* LWORK >= 3*min(M,N) + */
/* max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)). */
/* If JOBZ = 'S' or 'A' */
/* LWORK >= 3*min(M,N)*min(M,N) + */
/* LWORK >= 3*min(M,N) + */
/* max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)). */
/* For good performance, LWORK should generally be larger. */
/* If LWORK = -1 but other input arguments are legal, WORK(1) */

View File

@@ -1,5 +1,18 @@
/* dgesv.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"
/* Subroutine */ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer
*lda, integer *ipiv, doublereal *b, integer *ldb, integer *info)
{
@@ -12,7 +25,7 @@
integer *, integer *, doublereal *, integer *, integer *);
/* -- LAPACK driver routine (version 3.1) -- */
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgetf2.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 integer c__1 = 1;
@@ -26,7 +39,7 @@ static doublereal c_b8 = -1.;
extern /* Subroutine */ int xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgetrf.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 integer c__1 = 1;
@@ -30,7 +43,7 @@ static doublereal c_b19 = -1.;
integer *, integer *, integer *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgetri.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 integer c__1 = 1;
@@ -37,7 +50,7 @@ static doublereal c_b22 = 1.;
logical lquery;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dgetrs.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 integer c__1 = 1;
@@ -23,7 +36,7 @@ static integer c_n1 = -1;
logical notran;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,12 +1,25 @@
/* dlabad.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"
/* Subroutine */ int dlabad_(doublereal *small, doublereal *large)
{
/* Builtin functions */
double d_lg10(doublereal *), sqrt(doublereal);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlabrd.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.;
@@ -25,7 +38,7 @@ static doublereal c_b16 = 0.;
doublereal *, integer *, doublereal *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlacpy.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"
/* Subroutine */ int dlacpy_(char *uplo, integer *m, integer *n, doublereal *
a, integer *lda, doublereal *b, integer *ldb)
{
@@ -11,7 +24,7 @@
extern logical lsame_(char *, char *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlae2.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"
/* Subroutine */ int dlae2_(doublereal *a, doublereal *b, doublereal *c__,
doublereal *rt1, doublereal *rt2)
{
@@ -13,7 +26,7 @@
doublereal ab, df, tb, sm, rt, adf, acmn, acmx;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaebz.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"
/* Subroutine */ int dlaebz_(integer *ijob, integer *nitmax, integer *n,
integer *mmax, integer *minp, integer *nbmin, doublereal *abstol,
doublereal *reltol, doublereal *pivmin, doublereal *d__, doublereal *
@@ -18,7 +31,7 @@
integer itmp1, itmp2, kfnew, klnew;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed0.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 integer c__9 = 9;
@@ -55,7 +68,7 @@ static integer c__1 = 1;
integer curlvl, matsiz, iprmpt, smlsiz;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed1.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 integer c__1 = 1;
@@ -30,7 +43,7 @@ static integer c_n1 = -1;
integer coltyp;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed2.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_b3 = -1.;
@@ -38,7 +51,7 @@ static integer c__1 = 1;
integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed3.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 integer c__1 = 1;
@@ -35,7 +48,7 @@ static doublereal c_b23 = 0.;
doublereal *, integer *), xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed4.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"
/* Subroutine */ int dlaed4_(integer *n, integer *i__, doublereal *d__,
doublereal *z__, doublereal *delta, doublereal *rho, doublereal *dlam,
integer *info)
@@ -35,7 +48,7 @@
doublereal erretm, rhoinv;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed5.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"
/* Subroutine */ int dlaed5_(integer *i__, doublereal *d__, doublereal *z__,
doublereal *delta, doublereal *rho, doublereal *dlam)
{
@@ -13,7 +26,7 @@
doublereal b, c__, w, del, tau, temp;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed6.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"
/* Subroutine */ int dlaed6_(integer *kniter, logical *orgati, doublereal *
rho, doublereal *d__, doublereal *z__, doublereal *finit, doublereal *
tau, integer *info)
@@ -24,7 +37,7 @@
doublereal dscale[3], sclfac, zscale[3], erretm, sclinv;
/* -- LAPACK routine (version 3.1.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* February 2007 */

View File

@@ -1,5 +1,18 @@
/* dlaed7.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 integer c__2 = 2;
@@ -44,7 +57,7 @@ static integer c_n1 = -1;
integer coltyp;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed8.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_b3 = -1.;
@@ -37,7 +50,7 @@ static integer c__1 = 1;
integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaed9.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 integer c__1 = 1;
@@ -28,7 +41,7 @@ static integer c__1 = 1;
extern /* Subroutine */ int xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaeda.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 integer c__2 = 2;
@@ -31,7 +44,7 @@ static doublereal c_b26 = 0.;
integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaev2.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"
/* Subroutine */ int dlaev2_(doublereal *a, doublereal *b, doublereal *c__,
doublereal *rt1, doublereal *rt2, doublereal *cs1, doublereal *sn1)
{
@@ -15,7 +28,7 @@
doublereal acmn, acmx;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlagtf.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"
/* Subroutine */ int dlagtf_(integer *n, doublereal *a, doublereal *lambda,
doublereal *b, doublereal *c__, doublereal *tol, doublereal *d__,
integer *in, integer *info)
@@ -15,7 +28,7 @@
extern /* Subroutine */ int xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlagts.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"
/* Subroutine */ int dlagts_(integer *job, integer *n, doublereal *a,
doublereal *b, doublereal *c__, doublereal *d__, integer *in,
doublereal *y, doublereal *tol, integer *info)
@@ -19,7 +32,7 @@
doublereal bignum;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,12 +1,25 @@
/* dlaisnan.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"
logical dlaisnan_(doublereal *din1, doublereal *din2)
{
/* System generated locals */
logical ret_val;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -24,8 +37,7 @@ logical dlaisnan_(doublereal *din1, doublereal *din2)
/* returns .TRUE. To check for NaNs, pass the same variable as both */
/* arguments. */
/* Strictly speaking, Fortran does not allow aliasing of function */
/* arguments. So a compiler must assume that the two arguments are */
/* A compiler must assume that the two arguments are */
/* not the same variable, and the test will not be optimized away. */
/* Interprocedural or whole-program optimization may delete this */
/* test. The ISNAN functions will be replaced by the correct */

View File

@@ -1,5 +1,18 @@
/* dlals0.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_b5 = -1.;
@@ -45,7 +58,7 @@ static integer c__0 = 0;
doublereal dsigjp;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlalsa.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_b7 = 1.;
@@ -41,7 +54,7 @@ static integer c__2 = 2;
integer *, integer *, integer *), xerbla_(char *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlalsd.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 integer c__1 = 1;
@@ -73,7 +86,7 @@ static doublereal c_b11 = 1.;
integer givnum, givptr, smlszp;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlamrg.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"
/* Subroutine */ int dlamrg_(integer *n1, integer *n2, doublereal *a, integer
*dtrd1, integer *dtrd2, integer *index)
{
@@ -10,7 +23,7 @@
integer i__, ind1, ind2, n1sv, n2sv;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaneg.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"
integer dlaneg_(integer *n, doublereal *d__, doublereal *lld, doublereal *
sigma, doublereal *pivmin, integer *r__)
{
@@ -19,7 +32,7 @@ integer dlaneg_(integer *n, doublereal *d__, doublereal *lld, doublereal *
doublereal dminus;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlange.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 integer c__1 = 1;
@@ -23,7 +36,7 @@ doublereal dlange_(char *norm, integer *m, integer *n, doublereal *a, integer
doublereal *, doublereal *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlanst.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 integer c__1 = 1;
@@ -22,7 +35,7 @@ doublereal dlanst_(char *norm, integer *n, doublereal *d__, doublereal *e)
doublereal *, doublereal *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlansy.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 integer c__1 = 1;
@@ -23,7 +36,7 @@ doublereal dlansy_(char *norm, char *uplo, integer *n, doublereal *a, integer
doublereal *, doublereal *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlapy2.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"
doublereal dlapy2_(doublereal *x, doublereal *y)
{
/* System generated locals */
@@ -12,7 +25,7 @@ doublereal dlapy2_(doublereal *x, doublereal *y)
doublereal w, z__, xabs, yabs;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlar1v.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"
/* Subroutine */ int dlar1v_(integer *n, integer *b1, integer *bn, doublereal
*lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *
lld, doublereal *pivmin, doublereal *gaptol, doublereal *z__, logical
@@ -28,7 +41,7 @@
logical sawnan1, sawnan2;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -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;

View File

@@ -1,5 +1,18 @@
/* dlarfb.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 integer c__1 = 1;
@@ -21,14 +34,18 @@ static doublereal c_b25 = -1.;
integer *, doublereal *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *);
extern logical lsame_(char *, char *);
integer lastc;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *), dtrmm_(char *, char *, char *, char *,
integer *, integer *, doublereal *, doublereal *, integer *,
doublereal *, integer *);
integer lastv;
extern integer iladlc_(integer *, integer *, doublereal *, integer *),
iladlr_(integer *, integer *, doublereal *, integer *);
char transt[1];
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -161,58 +178,64 @@ static doublereal c_b25 = -1.;
/* Form H * C or H' * C where C = ( C1 ) */
/* ( C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlr_(m, k, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
/* W := C1' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
&c__1);
dcopy_(&lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1
+ 1], &c__1);
/* L10: */
}
/* W := W * V1 */
dtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b14,
&v[v_offset], ldv, &work[work_offset], ldwork);
if (*m > *k) {
dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
if (lastv > *k) {
/* W := W + C2'*V2 */
i__1 = *m - *k;
dgemm_("Transpose", "No transpose", n, k, &i__1, &c_b14, &
c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + v_dim1],
ldv, &c_b14, &work[work_offset], ldwork);
i__1 = lastv - *k;
dgemm_("Transpose", "No transpose", &lastc, k, &i__1, &
c_b14, &c__[*k + 1 + c_dim1], ldc, &v[*k + 1 +
v_dim1], ldv, &c_b14, &work[work_offset], ldwork);
}
/* W := W * T' or W * T */
dtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Upper", transt, "Non-unit", &lastc, k, &
c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - V * W' */
if (*m > *k) {
if (lastv > *k) {
/* C2 := C2 - V2 * W' */
i__1 = *m - *k;
dgemm_("No transpose", "Transpose", &i__1, n, k, &c_b25, &
v[*k + 1 + v_dim1], ldv, &work[work_offset],
ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc);
i__1 = lastv - *k;
dgemm_("No transpose", "Transpose", &i__1, &lastc, k, &
c_b25, &v[*k + 1 + v_dim1], ldv, &work[
work_offset], ldwork, &c_b14, &c__[*k + 1 +
c_dim1], ldc);
}
/* W := W * V1' */
dtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, &
v[v_offset], ldv, &work[work_offset], ldwork);
dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
/* C1 := C1 - W' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
/* L20: */
@@ -224,27 +247,32 @@ static doublereal c_b25 = -1.;
/* Form C * H or C * H' where C = ( C1 C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlr_(n, k, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
/* W := C1 */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
dcopy_(&lastc, &c__[j * c_dim1 + 1], &c__1, &work[j *
work_dim1 + 1], &c__1);
/* L40: */
}
/* W := W * V1 */
dtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b14,
&v[v_offset], ldv, &work[work_offset], ldwork);
if (*n > *k) {
dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
if (lastv > *k) {
/* W := W + C2 * V2 */
i__1 = *n - *k;
dgemm_("No transpose", "No transpose", m, k, &i__1, &
i__1 = lastv - *k;
dgemm_("No transpose", "No transpose", &lastc, k, &i__1, &
c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k +
1 + v_dim1], ldv, &c_b14, &work[work_offset],
ldwork);
@@ -252,31 +280,32 @@ static doublereal c_b25 = -1.;
/* W := W * T or W * T' */
dtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Upper", trans, "Non-unit", &lastc, k, &c_b14,
&t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - W * V' */
if (*n > *k) {
if (lastv > *k) {
/* C2 := C2 - W * V2' */
i__1 = *n - *k;
dgemm_("No transpose", "Transpose", m, &i__1, k, &c_b25, &
work[work_offset], ldwork, &v[*k + 1 + v_dim1],
ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc);
i__1 = lastv - *k;
dgemm_("No transpose", "Transpose", &lastc, &i__1, k, &
c_b25, &work[work_offset], ldwork, &v[*k + 1 +
v_dim1], ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1],
ldc);
}
/* W := W * V1' */
dtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, &
v[v_offset], ldv, &work[work_offset], ldwork);
dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
/* C1 := C1 - W */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *m;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
/* L50: */
@@ -296,63 +325,67 @@ static doublereal c_b25 = -1.;
/* Form H * C or H' * C where C = ( C1 ) */
/* ( C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlr_(m, k, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
/* W := C2' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
work_dim1 + 1], &c__1);
dcopy_(&lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[
j * work_dim1 + 1], &c__1);
/* L70: */
}
/* W := W * V2 */
dtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b14,
&v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
ldwork);
if (*m > *k) {
dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
work_offset], ldwork);
if (lastv > *k) {
/* W := W + C1'*V1 */
i__1 = *m - *k;
dgemm_("Transpose", "No transpose", n, k, &i__1, &c_b14, &
c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, &
work[work_offset], ldwork);
i__1 = lastv - *k;
dgemm_("Transpose", "No transpose", &lastc, k, &i__1, &
c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
c_b14, &work[work_offset], ldwork);
}
/* W := W * T' or W * T */
dtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Lower", transt, "Non-unit", &lastc, k, &
c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - V * W' */
if (*m > *k) {
if (lastv > *k) {
/* C1 := C1 - V1 * W' */
i__1 = *m - *k;
dgemm_("No transpose", "Transpose", &i__1, n, k, &c_b25, &
v[v_offset], ldv, &work[work_offset], ldwork, &
c_b14, &c__[c_offset], ldc)
;
i__1 = lastv - *k;
dgemm_("No transpose", "Transpose", &i__1, &lastc, k, &
c_b25, &v[v_offset], ldv, &work[work_offset],
ldwork, &c_b14, &c__[c_offset], ldc);
}
/* W := W * V2' */
dtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, &
v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
ldwork);
dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
work_offset], ldwork);
/* C2 := C2 - W' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
c__[lastv - *k + j + i__ * c_dim1] -= work[i__ + j *
work_dim1];
/* L80: */
}
@@ -363,64 +396,68 @@ static doublereal c_b25 = -1.;
/* Form C * H or C * H' where C = ( C1 C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlr_(n, k, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
/* W := C2 */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
j * work_dim1 + 1], &c__1);
dcopy_(&lastc, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &
work[j * work_dim1 + 1], &c__1);
/* L100: */
}
/* W := W * V2 */
dtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b14,
&v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
ldwork);
if (*n > *k) {
dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
work_offset], ldwork);
if (lastv > *k) {
/* W := W + C1 * V1 */
i__1 = *n - *k;
dgemm_("No transpose", "No transpose", m, k, &i__1, &
i__1 = lastv - *k;
dgemm_("No transpose", "No transpose", &lastc, k, &i__1, &
c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
c_b14, &work[work_offset], ldwork);
}
/* W := W * T or W * T' */
dtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Lower", trans, "Non-unit", &lastc, k, &c_b14,
&t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - W * V' */
if (*n > *k) {
if (lastv > *k) {
/* C1 := C1 - W * V1' */
i__1 = *n - *k;
dgemm_("No transpose", "Transpose", m, &i__1, k, &c_b25, &
work[work_offset], ldwork, &v[v_offset], ldv, &
c_b14, &c__[c_offset], ldc)
;
i__1 = lastv - *k;
dgemm_("No transpose", "Transpose", &lastc, &i__1, k, &
c_b25, &work[work_offset], ldwork, &v[v_offset],
ldv, &c_b14, &c__[c_offset], ldc);
}
/* W := W * V2' */
dtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, &
v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
ldwork);
dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
work_offset], ldwork);
/* C2 := C2 - W */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *m;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
work_dim1];
c__[i__ + (lastv - *k + j) * c_dim1] -= work[i__ + j *
work_dim1];
/* L110: */
}
/* L120: */
@@ -440,58 +477,64 @@ static doublereal c_b25 = -1.;
/* Form H * C or H' * C where C = ( C1 ) */
/* ( C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlc_(k, m, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
/* W := C1' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
&c__1);
dcopy_(&lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1
+ 1], &c__1);
/* L130: */
}
/* W := W * V1' */
dtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, &
v[v_offset], ldv, &work[work_offset], ldwork);
if (*m > *k) {
dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
if (lastv > *k) {
/* W := W + C2'*V2' */
i__1 = *m - *k;
dgemm_("Transpose", "Transpose", n, k, &i__1, &c_b14, &
c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 +
1], ldv, &c_b14, &work[work_offset], ldwork);
i__1 = lastv - *k;
dgemm_("Transpose", "Transpose", &lastc, k, &i__1, &c_b14,
&c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1
+ 1], ldv, &c_b14, &work[work_offset], ldwork);
}
/* W := W * T' or W * T */
dtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Upper", transt, "Non-unit", &lastc, k, &
c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - V' * W' */
if (*m > *k) {
if (lastv > *k) {
/* C2 := C2 - V2' * W' */
i__1 = *m - *k;
dgemm_("Transpose", "Transpose", &i__1, n, k, &c_b25, &v[(
*k + 1) * v_dim1 + 1], ldv, &work[work_offset],
ldwork, &c_b14, &c__[*k + 1 + c_dim1], ldc);
i__1 = lastv - *k;
dgemm_("Transpose", "Transpose", &i__1, &lastc, k, &c_b25,
&v[(*k + 1) * v_dim1 + 1], ldv, &work[
work_offset], ldwork, &c_b14, &c__[*k + 1 +
c_dim1], ldc);
}
/* W := W * V1 */
dtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b14,
&v[v_offset], ldv, &work[work_offset], ldwork);
dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
/* C1 := C1 - W' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
/* L140: */
@@ -503,45 +546,50 @@ static doublereal c_b25 = -1.;
/* Form C * H or C * H' where C = ( C1 C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlc_(k, n, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
/* W := C1 */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
dcopy_(&lastc, &c__[j * c_dim1 + 1], &c__1, &work[j *
work_dim1 + 1], &c__1);
/* L160: */
}
/* W := W * V1' */
dtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, &
v[v_offset], ldv, &work[work_offset], ldwork);
if (*n > *k) {
dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
if (lastv > *k) {
/* W := W + C2 * V2' */
i__1 = *n - *k;
dgemm_("No transpose", "Transpose", m, k, &i__1, &c_b14, &
c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) *
v_dim1 + 1], ldv, &c_b14, &work[work_offset],
ldwork);
i__1 = lastv - *k;
dgemm_("No transpose", "Transpose", &lastc, k, &i__1, &
c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k +
1) * v_dim1 + 1], ldv, &c_b14, &work[work_offset],
ldwork);
}
/* W := W * T or W * T' */
dtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Upper", trans, "Non-unit", &lastc, k, &c_b14,
&t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - W * V */
if (*n > *k) {
if (lastv > *k) {
/* C2 := C2 - W * V2 */
i__1 = *n - *k;
dgemm_("No transpose", "No transpose", m, &i__1, k, &
i__1 = lastv - *k;
dgemm_("No transpose", "No transpose", &lastc, &i__1, k, &
c_b25, &work[work_offset], ldwork, &v[(*k + 1) *
v_dim1 + 1], ldv, &c_b14, &c__[(*k + 1) * c_dim1
+ 1], ldc);
@@ -549,14 +597,14 @@ static doublereal c_b25 = -1.;
/* W := W * V1 */
dtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b14,
&v[v_offset], ldv, &work[work_offset], ldwork);
dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
/* C1 := C1 - W */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *m;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
/* L170: */
@@ -576,62 +624,67 @@ static doublereal c_b25 = -1.;
/* Form H * C or H' * C where C = ( C1 ) */
/* ( C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlc_(k, m, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
/* W := C2' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
work_dim1 + 1], &c__1);
dcopy_(&lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[
j * work_dim1 + 1], &c__1);
/* L190: */
}
/* W := W * V2' */
dtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, &
v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
, ldwork);
if (*m > *k) {
dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
work_offset], ldwork);
if (lastv > *k) {
/* W := W + C1'*V1' */
i__1 = *m - *k;
dgemm_("Transpose", "Transpose", n, k, &i__1, &c_b14, &
c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, &
i__1 = lastv - *k;
dgemm_("Transpose", "Transpose", &lastc, k, &i__1, &c_b14,
&c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, &
work[work_offset], ldwork);
}
/* W := W * T' or W * T */
dtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Lower", transt, "Non-unit", &lastc, k, &
c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - V' * W' */
if (*m > *k) {
if (lastv > *k) {
/* C1 := C1 - V1' * W' */
i__1 = *m - *k;
dgemm_("Transpose", "Transpose", &i__1, n, k, &c_b25, &v[
v_offset], ldv, &work[work_offset], ldwork, &
i__1 = lastv - *k;
dgemm_("Transpose", "Transpose", &i__1, &lastc, k, &c_b25,
&v[v_offset], ldv, &work[work_offset], ldwork, &
c_b14, &c__[c_offset], ldc);
}
/* W := W * V2 */
dtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b14,
&v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[
dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
work_offset], ldwork);
/* C2 := C2 - W' */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
c__[lastv - *k + j + i__ * c_dim1] -= work[i__ + j *
work_dim1];
/* L200: */
}
@@ -642,63 +695,68 @@ static doublereal c_b25 = -1.;
/* Form C * H or C * H' where C = ( C1 C2 ) */
/* Computing MAX */
i__1 = *k, i__2 = iladlc_(k, n, &v[v_offset], ldv);
lastv = max(i__1,i__2);
lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
/* W := C2 */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
j * work_dim1 + 1], &c__1);
dcopy_(&lastc, &c__[(lastv - *k + j) * c_dim1 + 1], &c__1,
&work[j * work_dim1 + 1], &c__1);
/* L220: */
}
/* W := W * V2' */
dtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, &
v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
, ldwork);
if (*n > *k) {
dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
work_offset], ldwork);
if (lastv > *k) {
/* W := W + C1 * V1' */
i__1 = *n - *k;
dgemm_("No transpose", "Transpose", m, k, &i__1, &c_b14, &
c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, &
work[work_offset], ldwork);
i__1 = lastv - *k;
dgemm_("No transpose", "Transpose", &lastc, k, &i__1, &
c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
c_b14, &work[work_offset], ldwork);
}
/* W := W * T or W * T' */
dtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b14, &t[
t_offset], ldt, &work[work_offset], ldwork);
dtrmm_("Right", "Lower", trans, "Non-unit", &lastc, k, &c_b14,
&t[t_offset], ldt, &work[work_offset], ldwork);
/* C := C - W * V */
if (*n > *k) {
if (lastv > *k) {
/* C1 := C1 - W * V1 */
i__1 = *n - *k;
dgemm_("No transpose", "No transpose", m, &i__1, k, &
i__1 = lastv - *k;
dgemm_("No transpose", "No transpose", &lastc, &i__1, k, &
c_b25, &work[work_offset], ldwork, &v[v_offset],
ldv, &c_b14, &c__[c_offset], ldc);
}
/* W := W * V2 */
dtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b14,
&v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[
dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
work_offset], ldwork);
/* C1 := C1 - W */
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
i__2 = *m;
i__2 = lastc;
for (i__ = 1; i__ <= i__2; ++i__) {
c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
work_dim1];
c__[i__ + (lastv - *k + j) * c_dim1] -= work[i__ + j *
work_dim1];
/* L230: */
}
/* L240: */

View File

@@ -1,5 +1,18 @@
/* dlarfg.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"
/* Subroutine */ int dlarfg_(integer *n, doublereal *alpha, doublereal *x,
integer *incx, doublereal *tau)
{
@@ -21,7 +34,7 @@
doublereal safmin, rsafmn;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -112,12 +125,12 @@
d__1 = dlapy2_(alpha, &xnorm);
beta = -d_sign(&d__1, alpha);
safmin = dlamch_("S") / dlamch_("E");
knt = 0;
if (abs(beta) < safmin) {
/* XNORM, BETA may be inaccurate; scale X and recompute them */
rsafmn = 1. / safmin;
knt = 0;
L10:
++knt;
i__1 = *n - 1;
@@ -134,26 +147,20 @@ L10:
xnorm = dnrm2_(&i__1, &x[1], incx);
d__1 = dlapy2_(alpha, &xnorm);
beta = -d_sign(&d__1, alpha);
*tau = (beta - *alpha) / beta;
i__1 = *n - 1;
d__1 = 1. / (*alpha - beta);
dscal_(&i__1, &d__1, &x[1], incx);
/* If ALPHA is subnormal, it may lose relative accuracy */
*alpha = beta;
i__1 = knt;
for (j = 1; j <= i__1; ++j) {
*alpha *= safmin;
/* L20: */
}
} else {
*tau = (beta - *alpha) / beta;
i__1 = *n - 1;
d__1 = 1. / (*alpha - beta);
dscal_(&i__1, &d__1, &x[1], incx);
*alpha = beta;
}
*tau = (beta - *alpha) / beta;
i__1 = *n - 1;
d__1 = 1. / (*alpha - beta);
dscal_(&i__1, &d__1, &x[1], incx);
/* If ALPHA is subnormal, it may lose relative accuracy */
i__1 = knt;
for (j = 1; j <= i__1; ++j) {
beta *= safmin;
/* L20: */
}
*alpha = beta;
}
return 0;

192
3rdparty/lapack/dlarfp.c vendored Normal file
View File

@@ -0,0 +1,192 @@
/* dlarfp.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"
/* Subroutine */ int dlarfp_(integer *n, doublereal *alpha, doublereal *x,
integer *incx, doublereal *tau)
{
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
double d_sign(doublereal *, doublereal *);
/* Local variables */
integer j, knt;
doublereal beta;
extern doublereal dnrm2_(integer *, doublereal *, integer *);
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
doublereal xnorm;
extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *);
doublereal safmin, rsafmn;
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DLARFP generates a real elementary reflector H of order n, such */
/* that */
/* H * ( alpha ) = ( beta ), H' * H = I. */
/* ( x ) ( 0 ) */
/* where alpha and beta are scalars, beta is non-negative, and x is */
/* an (n-1)-element real vector. H is represented in the form */
/* H = I - tau * ( 1 ) * ( 1 v' ) , */
/* ( v ) */
/* where tau is a real scalar and v is a real (n-1)-element */
/* vector. */
/* If the elements of x are all zero, then tau = 0 and H is taken to be */
/* the unit matrix. */
/* Otherwise 1 <= tau <= 2. */
/* Arguments */
/* ========= */
/* N (input) INTEGER */
/* The order of the elementary reflector. */
/* ALPHA (input/output) DOUBLE PRECISION */
/* On entry, the value alpha. */
/* On exit, it is overwritten with the value beta. */
/* X (input/output) DOUBLE PRECISION array, dimension */
/* (1+(N-2)*abs(INCX)) */
/* On entry, the vector x. */
/* On exit, it is overwritten with the vector v. */
/* INCX (input) INTEGER */
/* The increment between elements of X. INCX > 0. */
/* TAU (output) DOUBLE PRECISION */
/* The value tau. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
--x;
/* Function Body */
if (*n <= 0) {
*tau = 0.;
return 0;
}
i__1 = *n - 1;
xnorm = dnrm2_(&i__1, &x[1], incx);
if (xnorm == 0.) {
/* H = [+/-1, 0; I], sign chosen so ALPHA >= 0 */
if (*alpha >= 0.) {
/* When TAU.eq.ZERO, the vector is special-cased to be */
/* all zeros in the application routines. We do not need */
/* to clear it. */
*tau = 0.;
} else {
/* However, the application routines rely on explicit */
/* zero checks when TAU.ne.ZERO, and we must clear X. */
*tau = 2.;
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
x[(j - 1) * *incx + 1] = 0.;
}
*alpha = -(*alpha);
}
} else {
/* general case */
d__1 = dlapy2_(alpha, &xnorm);
beta = d_sign(&d__1, alpha);
safmin = dlamch_("S") / dlamch_("E");
knt = 0;
if (abs(beta) < safmin) {
/* XNORM, BETA may be inaccurate; scale X and recompute them */
rsafmn = 1. / safmin;
L10:
++knt;
i__1 = *n - 1;
dscal_(&i__1, &rsafmn, &x[1], incx);
beta *= rsafmn;
*alpha *= rsafmn;
if (abs(beta) < safmin) {
goto L10;
}
/* New BETA is at most 1, at least SAFMIN */
i__1 = *n - 1;
xnorm = dnrm2_(&i__1, &x[1], incx);
d__1 = dlapy2_(alpha, &xnorm);
beta = d_sign(&d__1, alpha);
}
*alpha += beta;
if (beta < 0.) {
beta = -beta;
*tau = -(*alpha) / beta;
} else {
*alpha = xnorm * (xnorm / *alpha);
*tau = *alpha / beta;
*alpha = -(*alpha);
}
i__1 = *n - 1;
d__1 = 1. / *alpha;
dscal_(&i__1, &d__1, &x[1], incx);
/* If BETA is subnormal, it may lose relative accuracy */
i__1 = knt;
for (j = 1; j <= i__1; ++j) {
beta *= safmin;
/* L20: */
}
*alpha = beta;
}
return 0;
/* End of DLARFP */
} /* dlarfp_ */

View File

@@ -1,5 +1,18 @@
/* dlarft.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 integer c__1 = 1;
@@ -14,17 +27,18 @@ static doublereal c_b8 = 0.;
doublereal d__1;
/* Local variables */
integer i__, j;
integer i__, j, prevlastv;
doublereal vii;
extern logical lsame_(char *, char *);
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *), dtrmv_(char *,
char *, char *, integer *, doublereal *, integer *, doublereal *,
integer *);
doublereal *, doublereal *, integer *);
integer lastv;
extern /* Subroutine */ int dtrmv_(char *, char *, char *, integer *,
doublereal *, 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 */
@@ -150,8 +164,10 @@ static doublereal c_b8 = 0.;
}
if (lsame_(direct, "F")) {
prevlastv = *n;
i__1 = *k;
for (i__ = 1; i__ <= i__1; ++i__) {
prevlastv = max(i__,prevlastv);
if (tau[i__] == 0.) {
/* H(i) = I */
@@ -168,21 +184,37 @@ static doublereal c_b8 = 0.;
vii = v[i__ + i__ * v_dim1];
v[i__ + i__ * v_dim1] = 1.;
if (lsame_(storev, "C")) {
/* Skip any trailing zeros. */
i__2 = i__ + 1;
for (lastv = *n; lastv >= i__2; --lastv) {
if (v[lastv + i__ * v_dim1] != 0.) {
break;
}
}
j = min(lastv,prevlastv);
/* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i) */
/* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)' * V(i:j,i) */
i__2 = *n - i__ + 1;
i__2 = j - i__ + 1;
i__3 = i__ - 1;
d__1 = -tau[i__];
dgemv_("Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1],
ldv, &v[i__ + i__ * v_dim1], &c__1, &c_b8, &t[
i__ * t_dim1 + 1], &c__1);
} else {
/* Skip any trailing zeros. */
i__2 = i__ + 1;
for (lastv = *n; lastv >= i__2; --lastv) {
if (v[i__ + lastv * v_dim1] != 0.) {
break;
}
}
j = min(lastv,prevlastv);
/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)' */
/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)' */
i__2 = i__ - 1;
i__3 = *n - i__ + 1;
i__3 = j - i__ + 1;
d__1 = -tau[i__];
dgemv_("No transpose", &i__2, &i__3, &d__1, &v[i__ *
v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
@@ -196,10 +228,16 @@ static doublereal c_b8 = 0.;
dtrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[
t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
t[i__ + i__ * t_dim1] = tau[i__];
if (i__ > 1) {
prevlastv = max(prevlastv,lastv);
} else {
prevlastv = lastv;
}
}
/* L20: */
}
} else {
prevlastv = 1;
for (i__ = *k; i__ >= 1; --i__) {
if (tau[i__] == 0.) {
@@ -218,31 +256,47 @@ static doublereal c_b8 = 0.;
if (lsame_(storev, "C")) {
vii = v[*n - *k + i__ + i__ * v_dim1];
v[*n - *k + i__ + i__ * v_dim1] = 1.;
/* Skip any leading zeros. */
i__1 = i__ - 1;
for (lastv = 1; lastv <= i__1; ++lastv) {
if (v[lastv + i__ * v_dim1] != 0.) {
break;
}
}
j = max(lastv,prevlastv);
/* T(i+1:k,i) := */
/* - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i) */
/* - tau(i) * V(j:n-k+i,i+1:k)' * V(j:n-k+i,i) */
i__1 = *n - *k + i__;
i__1 = *n - *k + i__ - j + 1;
i__2 = *k - i__;
d__1 = -tau[i__];
dgemv_("Transpose", &i__1, &i__2, &d__1, &v[(i__ + 1)
* v_dim1 + 1], ldv, &v[i__ * v_dim1 + 1], &
dgemv_("Transpose", &i__1, &i__2, &d__1, &v[j + (i__
+ 1) * v_dim1], ldv, &v[j + i__ * v_dim1], &
c__1, &c_b8, &t[i__ + 1 + i__ * t_dim1], &
c__1);
v[*n - *k + i__ + i__ * v_dim1] = vii;
} else {
vii = v[i__ + (*n - *k + i__) * v_dim1];
v[i__ + (*n - *k + i__) * v_dim1] = 1.;
/* Skip any leading zeros. */
i__1 = i__ - 1;
for (lastv = 1; lastv <= i__1; ++lastv) {
if (v[i__ + lastv * v_dim1] != 0.) {
break;
}
}
j = max(lastv,prevlastv);
/* T(i+1:k,i) := */
/* - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)' */
/* - tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)' */
i__1 = *k - i__;
i__2 = *n - *k + i__;
i__2 = *n - *k + i__ - j + 1;
d__1 = -tau[i__];
dgemv_("No transpose", &i__1, &i__2, &d__1, &v[i__ +
1 + v_dim1], ldv, &v[i__ + v_dim1], ldv, &
c_b8, &t[i__ + 1 + i__ * t_dim1], &c__1);
1 + j * v_dim1], ldv, &v[i__ + j * v_dim1],
ldv, &c_b8, &t[i__ + 1 + i__ * t_dim1], &c__1);
v[i__ + (*n - *k + i__) * v_dim1] = vii;
}
@@ -253,6 +307,11 @@ static doublereal c_b8 = 0.;
+ 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
t_dim1], &c__1)
;
if (i__ > 1) {
prevlastv = min(prevlastv,lastv);
} else {
prevlastv = lastv;
}
}
t[i__ + i__ * t_dim1] = tau[i__];
}

View File

@@ -1,5 +1,18 @@
/* dlarnv.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"
/* Subroutine */ int dlarnv_(integer *idist, integer *iseed, integer *n,
doublereal *x)
{
@@ -16,7 +29,7 @@
extern /* Subroutine */ int dlaruv_(integer *, integer *, doublereal *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlarra.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"
/* Subroutine */ int dlarra_(integer *n, doublereal *d__, doublereal *e,
doublereal *e2, doublereal *spltol, doublereal *tnrm, integer *nsplit,
integer *isplit, integer *info)
@@ -16,7 +29,7 @@
doublereal tmp1, eabs;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlarrb.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"
/* Subroutine */ int dlarrb_(integer *n, doublereal *d__, doublereal *lld,
integer *ifirst, integer *ilast, doublereal *rtol1, doublereal *rtol2,
integer *offset, doublereal *w, doublereal *wgap, doublereal *werr,
@@ -25,7 +38,7 @@
integer olnint, maxitr;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlarrc.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"
/* Subroutine */ int dlarrc_(char *jobt, integer *n, doublereal *vl,
doublereal *vu, doublereal *d__, doublereal *e, doublereal *pivmin,
integer *eigcnt, integer *lcnt, integer *rcnt, integer *info)
@@ -16,7 +29,7 @@
doublereal lpivot, rpivot;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlarrd.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 integer c__1 = 1;
@@ -48,16 +61,16 @@ static integer c__0 = 0;
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *);
integer irange, idiscl, idumma[1];
doublereal spdiam;
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *);
integer idiscu;
logical ncnvrg, toofew;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK auxiliary routine (version 3.2.1) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* -- April 2009 -- */
/* .. Scalar Arguments .. */
/* .. */
@@ -368,7 +381,8 @@ static integer c__0 = 0;
tnorm = max(d__1,d__2);
gl = gl - tnorm * 2. * eps * *n - *pivmin * 4.;
gu = gu + tnorm * 2. * eps * *n + *pivmin * 4.;
spdiam = gu - gl;
/* [JAN/28/2009] remove the line below since SPDIAM variable not use */
/* SPDIAM = GU - GL */
/* Input arguments for DLAEBZ: */
/* The relative tolerance. An interval (a,b] lies within */
/* "relative tolerance" if b-a < RELTOL*max(|a|,|b|), */
@@ -532,9 +546,14 @@ static integer c__0 = 0;
gu = max(d__1,d__2);
/* L40: */
}
spdiam = gu - gl;
gl = gl - spdiam * 2. * eps * in - *pivmin * 2.;
gu = gu + spdiam * 2. * eps * in + *pivmin * 2.;
/* [JAN/28/2009] */
/* change SPDIAM by TNORM in lines 2 and 3 thereafter */
/* line 1: remove computation of SPDIAM (not useful anymore) */
/* SPDIAM = GU - GL */
/* GL = GL - FUDGE*SPDIAM*EPS*IN - FUDGE*PIVMIN */
/* GU = GU + FUDGE*SPDIAM*EPS*IN + FUDGE*PIVMIN */
gl = gl - tnorm * 2. * eps * in - *pivmin * 2.;
gu = gu + tnorm * 2. * eps * in + *pivmin * 2.;
if (irange > 1) {
if (gu < *wl) {

View File

@@ -1,5 +1,18 @@
/* dlarre.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 integer c__1 = 1;
@@ -76,7 +89,7 @@ static integer c__2 = 2;
doublereal isrght, bsrtol, dpivot;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -352,6 +365,9 @@ static integer c__2 = 2;
/* Can force use of bisection instead of faster DQDS. */
/* Option left in the code for future multisection work. */
forceb = FALSE_;
/* Initialize USEDQD, DQDS should be used for ALLRNG unless someone */
/* explicitly wants bisection. */
usedqd = irange == 1 && ! forceb;
if (irange == 1 && ! forceb) {
/* Set interval [VL,VU] that contains all eigenvalues */
*vl = gl;

View File

@@ -1,5 +1,18 @@
/* dlarrf.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 integer c__1 = 1;
@@ -39,7 +52,7 @@ static integer c__1 = 1;
logical sawnan1, sawnan2, tryrrr1;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* * */

View File

@@ -1,5 +1,18 @@
/* dlarrj.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"
/* Subroutine */ int dlarrj_(integer *n, doublereal *d__, doublereal *e2,
integer *ifirst, integer *ilast, doublereal *rtol, integer *offset,
doublereal *w, doublereal *werr, doublereal *work, integer *iwork,
@@ -24,7 +37,7 @@
integer olnint, maxitr;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlarrk.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"
/* Subroutine */ int dlarrk_(integer *n, integer *iw, doublereal *gl,
doublereal *gu, doublereal *d__, doublereal *e2, doublereal *pivmin,
doublereal *reltol, doublereal *w, doublereal *werr, integer *info)
@@ -20,7 +33,7 @@
integer negcnt;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlarrr.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"
/* Subroutine */ int dlarrr_(integer *n, doublereal *d__, doublereal *e,
integer *info)
{
@@ -19,7 +32,7 @@
doublereal smlnum, offdig2;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlarrv.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_b5 = 0.;
@@ -94,7 +107,7 @@ static integer c__2 = 2;
integer isupmx;
/* -- LAPACK auxiliary routine (version 3.1.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlartg.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"
/* Subroutine */ int dlartg_(doublereal *f, doublereal *g, doublereal *cs,
doublereal *sn, doublereal *r__)
{
@@ -12,14 +25,14 @@
/* Local variables */
integer i__;
doublereal f1, g1, scale;
doublereal f1, g1, eps, scale;
integer count;
static doublereal safmn2, safmx2;
doublereal safmn2, safmx2;
extern doublereal dlamch_(char *);
static doublereal safmin, eps;
static volatile logical first = TRUE_;
doublereal safmin;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -85,15 +98,12 @@
/* .. Executable Statements .. */
/* IF( FIRST ) THEN */
if (first) {
safmin = dlamch_("S");
eps = dlamch_("E");
d__1 = dlamch_("B");
i__1 = (integer) (log(safmin / eps) / log(dlamch_("B")) / 2.);
safmn2 = pow_di(&d__1, &i__1);
safmx2 = 1. / safmn2;
first = FALSE_;
}
safmin = dlamch_("S");
eps = dlamch_("E");
d__1 = dlamch_("B");
i__1 = (integer) (log(safmin / eps) / log(dlamch_("B")) / 2.);
safmn2 = pow_di(&d__1, &i__1);
safmx2 = 1. / safmn2;
/* FIRST = .FALSE. */
/* END IF */
if (*g == 0.) {

View File

@@ -1,5 +1,18 @@
/* dlaruv.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"
/* Subroutine */ int dlaruv_(integer *iseed, integer *n, doublereal *x)
{
/* Initialized data */
@@ -51,7 +64,7 @@
integer i__, i1, i2, i3, i4, it1, it2, it3, it4;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlas2.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"
/* Subroutine */ int dlas2_(doublereal *f, doublereal *g, doublereal *h__,
doublereal *ssmin, doublereal *ssmax)
{
@@ -13,7 +26,7 @@
doublereal c__, fa, ga, ha, as, at, au, fhmn, fhmx;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlascl.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"
/* Subroutine */ int dlascl_(char *type__, integer *kl, integer *ku,
doublereal *cfrom, doublereal *cto, integer *m, integer *n,
doublereal *a, integer *lda, integer *info)
@@ -17,11 +30,12 @@
doublereal cfrom1;
extern doublereal dlamch_(char *);
doublereal cfromc;
extern logical disnan_(doublereal *);
extern /* Subroutine */ int xerbla_(char *, integer *);
doublereal bignum, smlnum;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
@@ -133,8 +147,10 @@
if (itype == -1) {
*info = -1;
} else if (*cfrom == 0.) {
} else if (*cfrom == 0. || disnan_(cfrom)) {
*info = -4;
} else if (disnan_(cto)) {
*info = -5;
} else if (*m < 0) {
*info = -6;
} else if (*n < 0 || itype == 4 && *n != *m || itype == 5 && *n != *m) {
@@ -181,18 +197,32 @@
L10:
cfrom1 = cfromc * smlnum;
cto1 = ctoc / bignum;
if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
mul = smlnum;
done = FALSE_;
cfromc = cfrom1;
} else if (abs(cto1) > abs(cfromc)) {
mul = bignum;
done = FALSE_;
ctoc = cto1;
} else {
if (cfrom1 == cfromc) {
/* CFROMC is an inf. Multiply by a correctly signed zero for */
/* finite CTOC, or a NaN if CTOC is infinite. */
mul = ctoc / cfromc;
done = TRUE_;
cto1 = ctoc;
} else {
cto1 = ctoc / bignum;
if (cto1 == ctoc) {
/* CTOC is either 0 or an inf. In both cases, CTOC itself */
/* serves as the correct multiplication factor. */
mul = ctoc;
done = TRUE_;
cfromc = 1.;
} else if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
mul = smlnum;
done = FALSE_;
cfromc = cfrom1;
} else if (abs(cto1) > abs(cfromc)) {
mul = bignum;
done = FALSE_;
ctoc = cto1;
} else {
mul = ctoc / cfromc;
done = TRUE_;
}
}
if (itype == 0) {

View File

@@ -1,5 +1,18 @@
/* dlasd0.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 integer c__0 = 0;
@@ -34,7 +47,7 @@ static integer c__2 = 2;
char *, 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 */

View File

@@ -1,5 +1,18 @@
/* dlasd1.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 integer c__0 = 0;
@@ -38,7 +51,7 @@ static integer c_n1 = -1;
integer coltyp;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasd2.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 integer c__1 = 1;
@@ -41,7 +54,7 @@ static doublereal c_b30 = 0.;
doublereal hlftol;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasd3.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 integer c__1 = 1;
@@ -44,7 +57,7 @@ static doublereal c_b26 = 0.;
xerbla_(char *, 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 */

View File

@@ -1,5 +1,18 @@
/* dlasd4.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"
/* Subroutine */ int dlasd4_(integer *n, integer *i__, doublereal *d__,
doublereal *z__, doublereal *delta, doublereal *rho, doublereal *
sigma, doublereal *work, integer *info)
@@ -38,7 +51,7 @@
doublereal erretm, dtipsq, rhoinv;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasd5.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"
/* Subroutine */ int dlasd5_(integer *i__, doublereal *d__, doublereal *z__,
doublereal *delta, doublereal *rho, doublereal *dsigma, doublereal *
work)
@@ -14,7 +27,7 @@
doublereal b, c__, w, del, tau, delsq;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasd6.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 integer c__0 = 0;
@@ -40,7 +53,7 @@ static integer c_n1 = -1;
doublereal orgnrm;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasd7.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 integer c__1 = 1;
@@ -34,7 +47,7 @@ static integer c__1 = 1;
doublereal hlftol;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasd8.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 integer c__1 = 1;
@@ -41,9 +54,9 @@ static doublereal c_b8 = 1.;
doublereal dsigjp;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* October 2006 */
/* .. Scalar Arguments .. */
/* .. */
@@ -78,9 +91,10 @@ static doublereal c_b8 = 1.;
/* D (output) DOUBLE PRECISION array, dimension ( K ) */
/* On output, D contains the updated singular values. */
/* Z (input) DOUBLE PRECISION array, dimension ( K ) */
/* The first K elements of this array contain the components */
/* of the deflation-adjusted updating row vector. */
/* Z (input/output) DOUBLE PRECISION array, dimension ( K ) */
/* On entry, the first K elements of this array contain the */
/* components of the deflation-adjusted updating row vector. */
/* On exit, Z is updated. */
/* VF (input/output) DOUBLE PRECISION array, dimension ( K ) */
/* On entry, VF contains information passed through DBEDE8. */
@@ -109,10 +123,12 @@ static doublereal c_b8 = 1.;
/* LDDIFR (input) INTEGER */
/* The leading dimension of DIFR, must be at least K. */
/* DSIGMA (input) DOUBLE PRECISION array, dimension ( K ) */
/* The first K elements of this array contain the old roots */
/* of the deflated updating problem. These are the poles */
/* DSIGMA (input/output) DOUBLE PRECISION array, dimension ( K ) */
/* On entry, the first K elements of this array contain the old */
/* roots of the deflated updating problem. These are the poles */
/* of the secular equation. */
/* On exit, the elements of DSIGMA may be very slightly altered */
/* in value. */
/* WORK (workspace) DOUBLE PRECISION array, dimension at least 3 * K */
@@ -198,7 +214,7 @@ static doublereal c_b8 = 1.;
/* changes the bottommost bits of DSIGMA(I). It does not account */
/* for hexadecimal or decimal machines without guard digits */
/* (we know of none). We use a subroutine call to compute */
/* 2*DSIGMA(I) to prevent optimizing compilers from eliminating */
/* 2*DLAMBDA(I) to prevent optimizing compilers from eliminating */
/* this code. */
i__1 = *k;

View File

@@ -1,5 +1,18 @@
/* dlasda.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 integer c__0 = 0;
@@ -51,7 +64,7 @@ static integer c__2 = 2;
integer smlszp;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasdq.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 integer c__1 = 1;
@@ -33,7 +46,7 @@ static integer c__1 = 1;
logical rotate;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasdt.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"
/* Subroutine */ int dlasdt_(integer *n, integer *lvl, integer *nd, integer *
inode, integer *ndiml, integer *ndimr, integer *msub)
{
@@ -15,7 +28,7 @@
integer nlvl, llst, ncrnt;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaset.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"
/* Subroutine */ int dlaset_(char *uplo, integer *m, integer *n, doublereal *
alpha, doublereal *beta, doublereal *a, integer *lda)
{
@@ -11,7 +24,7 @@
extern logical lsame_(char *, char *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasq1.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 integer c__1 = 1;
@@ -37,9 +50,15 @@ static integer c__0 = 0;
char *, integer *, doublereal *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK routine (version 3.2) -- */
/* -- Contributed by Osni Marques of the Lawrence Berkeley National -- */
/* -- Laboratory and Beresford Parlett of the Univ. of California at -- */
/* -- Berkeley -- */
/* -- November 2008 -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* .. Scalar Arguments .. */
/* .. */

View File

@@ -1,5 +1,18 @@
/* dlasq2.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 integer c__1 = 1;
@@ -19,31 +32,32 @@ static integer c__11 = 11;
double sqrt(doublereal);
/* Local variables */
doublereal d__, e;
doublereal d__, e, g;
integer k;
doublereal s, t;
integer i0, i4, n0;
doublereal dn;
integer pp;
doublereal dn1, dn2, eps, tau, tol;
doublereal dn1, dn2, dee, eps, tau, tol;
integer ipn4;
doublereal tol2;
logical ieee;
integer nbig;
doublereal dmin__, emin, emax;
integer ndiv, iter;
integer kmin, ndiv, iter;
doublereal qmin, temp, qmax, zmax;
integer splt;
doublereal dmin1, dmin2;
integer nfail;
doublereal desig, trace, sigma;
integer iinfo, ttype;
extern /* Subroutine */ int dlazq3_(integer *, integer *, doublereal *,
extern /* Subroutine */ int dlasq3_(integer *, integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
integer *, integer *, integer *, logical *, integer *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *);
doublereal *, doublereal *, doublereal *);
extern doublereal dlamch_(char *);
doublereal deemin;
integer iwhila, iwhilb;
doublereal oldemn, safmin;
extern /* Subroutine */ int xerbla_(char *, integer *);
@@ -53,11 +67,15 @@ static integer c__11 = 11;
integer *);
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK routine (version 3.2) -- */
/* Modified to call DLAZQ3 in place of DLASQ3, 13 Feb 03, SJH. */
/* -- Contributed by Osni Marques of the Lawrence Berkeley National -- */
/* -- Laboratory and Beresford Parlett of the Univ. of California at -- */
/* -- Berkeley -- */
/* -- November 2008 -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* .. Scalar Arguments .. */
/* .. */
@@ -81,7 +99,7 @@ static integer c__11 = 11;
/* Note : DLASQ2 defines a logical variable, IEEE, which is true */
/* on machines which follow ieee-754 floating-point standard in their */
/* handling of infinities and NaNs, and false otherwise. This variable */
/* is passed to DLAZQ3. */
/* is passed to DLASQ3. */
/* Arguments */
/* ========= */
@@ -89,7 +107,7 @@ static integer c__11 = 11;
/* N (input) INTEGER */
/* The number of rows and columns in the matrix. N >= 0. */
/* Z (workspace) DOUBLE PRECISION array, dimension ( 4*N ) */
/* Z (input/output) DOUBLE PRECISION array, dimension ( 4*N ) */
/* On entry Z holds the qd array. On exit, entries 1 to N hold */
/* the eigenvalues in decreasing order, Z( 2*N+1 ) holds the */
/* trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If */
@@ -355,7 +373,7 @@ static integer c__11 = 11;
/* L80: */
}
/* Initialise variables to pass to DLAZQ3 */
/* Initialise variables to pass to DLASQ3. */
ttype = 0;
dmin1 = 0.;
@@ -363,6 +381,7 @@ static integer c__11 = 11;
dn = 0.;
dn1 = 0.;
dn2 = 0.;
g = 0.;
tau = 0.;
iter = 2;
@@ -372,7 +391,7 @@ static integer c__11 = 11;
i__1 = *n + 1;
for (iwhila = 1; iwhila <= i__1; ++iwhila) {
if (n0 < 1) {
goto L150;
goto L170;
}
/* While array unfinished do */
@@ -426,10 +445,43 @@ static integer c__11 = 11;
L100:
i0 = i4 / 4;
pp = 0;
/* Store EMIN for passing to DLAZQ3. */
z__[(n0 << 2) - 1] = emin;
if (n0 - i0 > 1) {
dee = z__[(i0 << 2) - 3];
deemin = dee;
kmin = i0;
i__2 = (n0 << 2) - 3;
for (i4 = (i0 << 2) + 1; i4 <= i__2; i4 += 4) {
dee = z__[i4] * (dee / (dee + z__[i4 - 2]));
if (dee <= deemin) {
deemin = dee;
kmin = (i4 + 3) / 4;
}
/* L110: */
}
if (kmin - i0 << 1 < n0 - kmin && deemin <= z__[(n0 << 2) - 3] *
.5) {
ipn4 = i0 + n0 << 2;
pp = 2;
i__2 = i0 + n0 - 1 << 1;
for (i4 = i0 << 2; i4 <= i__2; i4 += 4) {
temp = z__[i4 - 3];
z__[i4 - 3] = z__[ipn4 - i4 - 3];
z__[ipn4 - i4 - 3] = temp;
temp = z__[i4 - 2];
z__[i4 - 2] = z__[ipn4 - i4 - 2];
z__[ipn4 - i4 - 2] = temp;
temp = z__[i4 - 1];
z__[i4 - 1] = z__[ipn4 - i4 - 5];
z__[ipn4 - i4 - 5] = temp;
temp = z__[i4];
z__[i4] = z__[ipn4 - i4 - 4];
z__[ipn4 - i4 - 4] = temp;
/* L120: */
}
}
}
/* Put -(initial shift) into DMIN. */
@@ -437,22 +489,24 @@ L100:
d__1 = 0., d__2 = qmin - sqrt(qmin) * 2. * sqrt(emax);
dmin__ = -max(d__1,d__2);
/* Now I0:N0 is unreduced. PP = 0 for ping, PP = 1 for pong. */
pp = 0;
/* Now I0:N0 is unreduced. */
/* PP = 0 for ping, PP = 1 for pong. */
/* PP = 2 indicates that flipping was applied to the Z array and */
/* and that the tests for deflation upon entry in DLASQ3 */
/* should not be performed. */
nbig = (n0 - i0 + 1) * 30;
i__2 = nbig;
for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
if (i0 > n0) {
goto L130;
goto L150;
}
/* While submatrix unfinished take a good dqds step. */
dlazq3_(&i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, &
dlasq3_(&i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, &
nfail, &iter, &ndiv, &ieee, &ttype, &dmin1, &dmin2, &dn, &
dn1, &dn2, &tau);
dn1, &dn2, &g, &tau);
pp = 1 - pp;
@@ -485,7 +539,7 @@ L100:
d__1 = oldemn, d__2 = z__[i4];
oldemn = min(d__1,d__2);
}
/* L110: */
/* L130: */
}
z__[(n0 << 2) - 1] = emin;
z__[n0 * 4] = oldemn;
@@ -493,7 +547,7 @@ L100:
}
}
/* L120: */
/* L140: */
}
*info = 2;
@@ -501,9 +555,9 @@ L100:
/* end IWHILB */
L130:
L150:
/* L140: */
/* L160: */
;
}
@@ -512,14 +566,14 @@ L130:
/* end IWHILA */
L150:
L170:
/* Move q's to the front. */
i__1 = *n;
for (k = 2; k <= i__1; ++k) {
z__[k] = z__[(k << 2) - 3];
/* L160: */
/* L180: */
}
/* Sort and compute sum of eigenvalues. */
@@ -529,7 +583,7 @@ L150:
e = 0.;
for (k = *n; k >= 1; --k) {
e += z__[k];
/* L170: */
/* L190: */
}
/* Store trace, sum(eigenvalues) and information on performance. */

View File

@@ -1,20 +1,25 @@
/* dlasq3.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"
/* Subroutine */ int dlasq3_(integer *i0, integer *n0, doublereal *z__,
integer *pp, doublereal *dmin__, doublereal *sigma, doublereal *desig,
doublereal *qmax, integer *nfail, integer *iter, integer *ndiv,
logical *ieee)
logical *ieee, integer *ttype, doublereal *dmin1, doublereal *dmin2,
doublereal *dn, doublereal *dn1, doublereal *dn2, doublereal *g,
doublereal *tau)
{
/* Initialized data */
static integer ttype = 0;
static doublereal dmin1 = 0.;
static doublereal dmin2 = 0.;
static doublereal dn = 0.;
static doublereal dn1 = 0.;
static doublereal dn2 = 0.;
static doublereal tau = 0.;
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
@@ -30,20 +35,26 @@
doublereal tol2, temp;
extern /* Subroutine */ int dlasq4_(integer *, integer *, doublereal *,
integer *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *)
, dlasq5_(integer *, integer *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, logical *), dlasq6_(
doublereal *, doublereal *, doublereal *, doublereal *, integer *,
doublereal *), dlasq5_(integer *, integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, logical *), dlasq6_(
integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
extern doublereal dlamch_(char *);
doublereal safmin;
extern logical disnan_(doublereal *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK routine (version 3.2) -- */
/* -- Contributed by Osni Marques of the Lawrence Berkeley National -- */
/* -- Laboratory and Beresford Parlett of the Univ. of California at -- */
/* -- Berkeley -- */
/* -- November 2008 -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* .. Scalar Arguments .. */
/* .. */
@@ -69,8 +80,11 @@
/* Z (input) DOUBLE PRECISION array, dimension ( 4*N ) */
/* Z holds the qd array. */
/* PP (input) INTEGER */
/* PP (input/output) INTEGER */
/* PP=0 for ping, PP=1 for pong. */
/* PP=2 indicates that flipping was applied to the Z array */
/* and that the initial tests for deflation should not be */
/* performed. */
/* DMIN (output) DOUBLE PRECISION */
/* Minimum value of d. */
@@ -93,12 +107,16 @@
/* NDIV (output) INTEGER */
/* Number of divisions. */
/* TTYPE (output) INTEGER */
/* Shift type. */
/* IEEE (input) LOGICAL */
/* Flag for IEEE or non IEEE arithmetic (passed to DLASQ5). */
/* TTYPE (input/output) INTEGER */
/* Shift type. */
/* DMIN1, DMIN2, DN, DN1, DN2, G, TAU (input/output) DOUBLE PRECISION */
/* These are passed as arguments in order to save their values */
/* between calls to DLASQ3. */
/* ===================================================================== */
/* .. Parameters .. */
@@ -111,19 +129,14 @@
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Save statement .. */
/* .. */
/* .. Data statement .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
--z__;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
n0in = *n0;
eps = dlamch_("Precision");
safmin = dlamch_("Safe minimum");
tol = eps * 100.;
/* Computing 2nd power */
d__1 = tol;
@@ -191,6 +204,9 @@ L40:
goto L10;
L50:
if (*pp == 2) {
*pp = 0;
}
/* Reverse the qd-array, if warranted. */
@@ -218,8 +234,8 @@ L50:
z__[(*n0 << 2) - *pp] = z__[(*i0 << 2) - *pp];
}
/* Computing MIN */
d__1 = dmin2, d__2 = z__[(*n0 << 2) + *pp - 1];
dmin2 = min(d__1,d__2);
d__1 = *dmin2, d__2 = z__[(*n0 << 2) + *pp - 1];
*dmin2 = min(d__1,d__2);
/* Computing MIN */
d__1 = z__[(*n0 << 2) + *pp - 1], d__2 = z__[(*i0 << 2) + *pp - 1]
, d__1 = min(d__1,d__2), d__2 = z__[(*i0 << 2) + *pp + 3];
@@ -236,96 +252,94 @@ L50:
}
}
/* Computing MIN */
d__1 = z__[(*n0 << 2) + *pp - 1], d__2 = z__[(*n0 << 2) + *pp - 9], d__1 =
min(d__1,d__2), d__2 = dmin2 + z__[(*n0 << 2) - *pp];
if (*dmin__ < 0. || safmin * *qmax < min(d__1,d__2)) {
/* Choose a shift. */
/* Choose a shift. */
dlasq4_(i0, n0, &z__[1], pp, &n0in, dmin__, dmin1, dmin2, dn, dn1, dn2,
tau, ttype, g);
dlasq4_(i0, n0, &z__[1], pp, &n0in, dmin__, &dmin1, &dmin2, &dn, &dn1,
&dn2, &tau, &ttype);
/* Call dqds until DMIN > 0. */
/* Call dqds until DMIN > 0. */
L70:
L80:
dlasq5_(i0, n0, &z__[1], pp, tau, dmin__, dmin1, dmin2, dn, dn1, dn2,
ieee);
dlasq5_(i0, n0, &z__[1], pp, &tau, dmin__, &dmin1, &dmin2, &dn, &dn1,
&dn2, ieee);
*ndiv += *n0 - *i0 + 2;
++(*iter);
*ndiv += *n0 - *i0 + 2;
++(*iter);
/* Check status. */
/* Check status. */
if (*dmin__ >= 0. && *dmin1 > 0.) {
if (*dmin__ >= 0. && dmin1 > 0.) {
/* Success. */
/* Success. */
goto L90;
goto L100;
} else if (*dmin__ < 0. && *dmin1 > 0. && z__[(*n0 - 1 << 2) - *pp] < tol
* (*sigma + *dn1) && abs(*dn) < tol * *sigma) {
} else if (*dmin__ < 0. && dmin1 > 0. && z__[(*n0 - 1 << 2) - *pp] <
tol * (*sigma + dn1) && abs(dn) < tol * *sigma) {
/* Convergence hidden by negative DN. */
/* Convergence hidden by negative DN. */
z__[(*n0 - 1 << 2) - *pp + 2] = 0.;
*dmin__ = 0.;
goto L90;
} else if (*dmin__ < 0.) {
z__[(*n0 - 1 << 2) - *pp + 2] = 0.;
*dmin__ = 0.;
goto L100;
} else if (*dmin__ < 0.) {
/* TAU too big. Select new TAU and try again. */
/* TAU too big. Select new TAU and try again. */
++(*nfail);
if (*ttype < -22) {
++(*nfail);
if (ttype < -22) {
/* Failed twice. Play it safe. */
/* Failed twice. Play it safe. */
*tau = 0.;
} else if (*dmin1 > 0.) {
tau = 0.;
} else if (dmin1 > 0.) {
/* Late failure. Gives excellent shift. */
/* Late failure. Gives excellent shift. */
tau = (tau + *dmin__) * (1. - eps * 2.);
ttype += -11;
} else {
/* Early failure. Divide by 4. */
tau *= .25;
ttype += -12;
}
goto L80;
} else if (*dmin__ != *dmin__) {
/* NaN. */
tau = 0.;
goto L80;
*tau = (*tau + *dmin__) * (1. - eps * 2.);
*ttype += -11;
} else {
/* Possible underflow. Play it safe. */
/* Early failure. Divide by 4. */
goto L90;
*tau *= .25;
*ttype += -12;
}
goto L70;
} else if (disnan_(dmin__)) {
/* NaN. */
if (*tau == 0.) {
goto L80;
} else {
*tau = 0.;
goto L70;
}
} else {
/* Possible underflow. Play it safe. */
goto L80;
}
/* Risk of underflow. */
L90:
dlasq6_(i0, n0, &z__[1], pp, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2);
L80:
dlasq6_(i0, n0, &z__[1], pp, dmin__, dmin1, dmin2, dn, dn1, dn2);
*ndiv += *n0 - *i0 + 2;
++(*iter);
tau = 0.;
*tau = 0.;
L100:
if (tau < *sigma) {
*desig += tau;
L90:
if (*tau < *sigma) {
*desig += *tau;
t = *sigma + *desig;
*desig -= t - *sigma;
} else {
t = *sigma + tau;
*desig = *sigma - (t - tau) + *desig;
t = *sigma + *tau;
*desig = *sigma - (t - *tau) + *desig;
}
*sigma = t;

View File

@@ -1,14 +1,23 @@
/* dlasq4.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"
/* Subroutine */ int dlasq4_(integer *i0, integer *n0, doublereal *z__,
integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1,
doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2,
doublereal *tau, integer *ttype)
doublereal *tau, integer *ttype, doublereal *g)
{
/* Initialized data */
static doublereal g = 0.;
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
@@ -22,9 +31,15 @@
doublereal gam, gap1, gap2;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK routine (version 3.2) -- */
/* -- Contributed by Osni Marques of the Lawrence Berkeley National -- */
/* -- Laboratory and Beresford Parlett of the Univ. of California at -- */
/* -- Berkeley -- */
/* -- November 2008 -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* .. Scalar Arguments .. */
/* .. */
@@ -49,7 +64,7 @@
/* PP (input) INTEGER */
/* PP=0 for ping, PP=1 for pong. */
/* N0IN (input) INTEGER */
/* NOIN (input) INTEGER */
/* The value of N0 at start of EIGTEST. */
/* DMIN (input) DOUBLE PRECISION */
@@ -76,6 +91,10 @@
/* TTYPE (output) INTEGER */
/* Shift type. */
/* G (input/output) REAL */
/* G is passed as an argument in order to save its value between */
/* calls to DLASQ4. */
/* Further Details */
/* =============== */
/* CNST1 = 9/16 */
@@ -88,19 +107,15 @@
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Save statement .. */
/* .. */
/* .. Data statement .. */
/* Parameter adjustments */
--z__;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
/* A negative DMIN forces the shift to take that absolute value */
/* TTYPE records the type of shift. */
/* Parameter adjustments */
--z__;
/* Function Body */
if (*dmin__ <= 0.) {
*tau = -(*dmin__);
*ttype = -1;
@@ -255,13 +270,13 @@ L40:
/* Case 6, no information to guide us. */
if (*ttype == -6) {
g += (1. - g) * .333;
*g += (1. - *g) * .333;
} else if (*ttype == -18) {
g = .083250000000000005;
*g = .083250000000000005;
} else {
g = .25;
*g = .25;
}
s = g * *dmin__;
s = *g * *dmin__;
*ttype = -6;
}

View File

@@ -1,5 +1,18 @@
/* dlasq5.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"
/* Subroutine */ int dlasq5_(integer *i0, integer *n0, doublereal *z__,
integer *pp, doublereal *tau, doublereal *dmin__, doublereal *dmin1,
doublereal *dmin2, doublereal *dn, doublereal *dnm1, doublereal *dnm2,
@@ -15,9 +28,15 @@
doublereal emin, temp;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK routine (version 3.2) -- */
/* -- Contributed by Osni Marques of the Lawrence Berkeley National -- */
/* -- Laboratory and Beresford Parlett of the Univ. of California at -- */
/* -- Berkeley -- */
/* -- November 2008 -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* .. Scalar Arguments .. */
/* .. */

View File

@@ -1,5 +1,18 @@
/* dlasq6.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"
/* Subroutine */ int dlasq6_(integer *i0, integer *n0, doublereal *z__,
integer *pp, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2,
doublereal *dn, doublereal *dnm1, doublereal *dnm2)
@@ -16,9 +29,15 @@
doublereal safmin;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* -- LAPACK routine (version 3.2) -- */
/* -- Contributed by Osni Marques of the Lawrence Berkeley National -- */
/* -- Laboratory and Beresford Parlett of the Univ. of California at -- */
/* -- Berkeley -- */
/* -- November 2008 -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* .. Scalar Arguments .. */
/* .. */

View File

@@ -1,5 +1,18 @@
/* dlasr.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"
/* Subroutine */ int dlasr_(char *side, char *pivot, char *direct, integer *m,
integer *n, doublereal *c__, doublereal *s, doublereal *a, integer *
lda)
@@ -15,7 +28,7 @@
extern /* Subroutine */ int xerbla_(char *, 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 */

View File

@@ -1,5 +1,18 @@
/* dlasrt.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"
/* Subroutine */ int dlasrt_(char *id, integer *n, doublereal *d__, integer *
info)
{
@@ -20,7 +33,7 @@
integer stkpnt;
/* -- LAPACK routine (version 3.1) -- */
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlassq.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"
/* Subroutine */ int dlassq_(integer *n, doublereal *x, integer *incx,
doublereal *scale, doublereal *sumsq)
{
@@ -12,7 +25,7 @@
doublereal absxi;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlasv2.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_b3 = 2.;
@@ -26,7 +39,7 @@ static doublereal c_b4 = 1.;
logical gasmal;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlaswp.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"
/* Subroutine */ int dlaswp_(integer *n, doublereal *a, integer *lda, integer
*k1, integer *k2, integer *ipiv, integer *incx)
{
@@ -11,7 +24,7 @@
doublereal temp;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,111 +1,40 @@
/* dlasyf.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"
/* Subroutine */ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb,
/* Table of constant values */
static integer c__1 = 1;
static doublereal c_b8 = -1.;
static doublereal c_b9 = 1.;
/* Subroutine */ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb,
doublereal *a, integer *lda, integer *ipiv, doublereal *w, integer *
ldw, integer *info)
{
/* -- LAPACK routine (version 3.1) --
Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
November 2006
Purpose
=======
DLASYF computes a partial factorization of a real symmetric matrix A
using the Bunch-Kaufman diagonal pivoting method. The partial
factorization has the form:
A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or:
( 0 U22 ) ( 0 D ) ( U12' U22' )
A = ( L11 0 ) ( D 0 ) ( L11' L21' ) if UPLO = 'L'
( L21 I ) ( 0 A22 ) ( 0 I )
where the order of D is at most NB. The actual order is returned in
the argument KB, and is either NB or NB-1, or N if N <= NB.
DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code
(calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
A22 (if UPLO = 'L').
Arguments
=========
UPLO (input) CHARACTER*1
Specifies whether the upper or lower triangular part of the
symmetric matrix A is stored:
= 'U': Upper triangular
= 'L': Lower triangular
N (input) INTEGER
The order of the matrix A. N >= 0.
NB (input) INTEGER
The maximum number of columns of the matrix A that should be
factored. NB should be at least 2 to allow for 2-by-2 pivot
blocks.
KB (output) INTEGER
The number of columns of A that were actually factored.
KB is either NB-1 or NB, or N if N <= NB.
A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
On entry, the symmetric matrix A. If UPLO = 'U', the leading
n-by-n upper triangular part of A contains the upper
triangular part of the matrix A, and the strictly lower
triangular part of A is not referenced. If UPLO = 'L', the
leading n-by-n lower triangular part of A contains the lower
triangular part of the matrix A, and the strictly upper
triangular part of A is not referenced.
On exit, A contains details of the partial factorization.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
IPIV (output) INTEGER array, dimension (N)
Details of the interchanges and the block structure of D.
If UPLO = 'U', only the last KB elements of IPIV are set;
if UPLO = 'L', only the first KB elements are set.
If IPIV(k) > 0, then rows and columns k and IPIV(k) were
interchanged and D(k,k) is a 1-by-1 diagonal block.
If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) =
IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
W (workspace) DOUBLE PRECISION array, dimension (LDW,NB)
LDW (input) INTEGER
The leading dimension of the array W. LDW >= max(1,N).
INFO (output) INTEGER
= 0: successful exit
> 0: if INFO = k, D(k,k) is exactly zero. The factorization
has been completed, but the block diagonal matrix D is
exactly singular.
=====================================================================
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static doublereal c_b8 = -1.;
static doublereal c_b9 = 1.;
/* System generated locals */
integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4, i__5;
doublereal d__1, d__2, d__3;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer j, k;
static doublereal t, r1, d11, d21, d22;
static integer jb, jj, kk, jp, kp, kw, kkw, imax, jmax;
static doublereal alpha;
integer j, k;
doublereal t, r1, d11, d21, d22;
integer jb, jj, kk, jp, kp, kw, kkw, imax, jmax;
doublereal alpha;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *), dgemm_(char *, char *, integer *, integer *, integer *
, doublereal *, doublereal *, integer *, doublereal *, integer *,
@@ -116,12 +45,114 @@
doublereal *, doublereal *, integer *), dcopy_(integer *,
doublereal *, integer *, doublereal *, integer *), dswap_(integer
*, doublereal *, integer *, doublereal *, integer *);
static integer kstep;
static doublereal absakk;
integer kstep;
doublereal absakk;
extern integer idamax_(integer *, doublereal *, integer *);
static doublereal colmax, rowmax;
doublereal colmax, rowmax;
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DLASYF computes a partial factorization of a real symmetric matrix A */
/* using the Bunch-Kaufman diagonal pivoting method. The partial */
/* factorization has the form: */
/* A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or: */
/* ( 0 U22 ) ( 0 D ) ( U12' U22' ) */
/* A = ( L11 0 ) ( D 0 ) ( L11' L21' ) if UPLO = 'L' */
/* ( L21 I ) ( 0 A22 ) ( 0 I ) */
/* where the order of D is at most NB. The actual order is returned in */
/* the argument KB, and is either NB or NB-1, or N if N <= NB. */
/* DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code */
/* (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or */
/* A22 (if UPLO = 'L'). */
/* Arguments */
/* ========= */
/* UPLO (input) CHARACTER*1 */
/* Specifies whether the upper or lower triangular part of the */
/* symmetric matrix A is stored: */
/* = 'U': Upper triangular */
/* = 'L': Lower triangular */
/* N (input) INTEGER */
/* The order of the matrix A. N >= 0. */
/* NB (input) INTEGER */
/* The maximum number of columns of the matrix A that should be */
/* factored. NB should be at least 2 to allow for 2-by-2 pivot */
/* blocks. */
/* KB (output) INTEGER */
/* The number of columns of A that were actually factored. */
/* KB is either NB-1 or NB, or N if N <= NB. */
/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
/* On entry, the symmetric matrix A. If UPLO = 'U', the leading */
/* n-by-n upper triangular part of A contains the upper */
/* triangular part of the matrix A, and the strictly lower */
/* triangular part of A is not referenced. If UPLO = 'L', the */
/* leading n-by-n lower triangular part of A contains the lower */
/* triangular part of the matrix A, and the strictly upper */
/* triangular part of A is not referenced. */
/* On exit, A contains details of the partial factorization. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* IPIV (output) INTEGER array, dimension (N) */
/* Details of the interchanges and the block structure of D. */
/* If UPLO = 'U', only the last KB elements of IPIV are set; */
/* if UPLO = 'L', only the first KB elements are set. */
/* If IPIV(k) > 0, then rows and columns k and IPIV(k) were */
/* interchanged and D(k,k) is a 1-by-1 diagonal block. */
/* If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and */
/* columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k) */
/* is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) = */
/* IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were */
/* interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block. */
/* W (workspace) DOUBLE PRECISION array, dimension (LDW,NB) */
/* LDW (input) INTEGER */
/* The leading dimension of the array W. LDW >= max(1,N). */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* > 0: if INFO = k, D(k,k) is exactly zero. The factorization */
/* has been completed, but the block diagonal matrix D is */
/* exactly singular. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
@@ -139,13 +170,13 @@
if (lsame_(uplo, "U")) {
/* Factorize the trailing columns of A using the upper triangle
of A and working backwards, and compute the matrix W = U12*D
for use in updating A11
/* Factorize the trailing columns of A using the upper triangle */
/* of A and working backwards, and compute the matrix W = U12*D */
/* for use in updating A11 */
K is the main loop index, decreasing from N in steps of 1 or 2
/* K is the main loop index, decreasing from N in steps of 1 or 2 */
KW is the column of W which corresponds to column K of A */
/* KW is the column of W which corresponds to column K of A */
k = *n;
L10:
@@ -169,13 +200,13 @@ L10:
kstep = 1;
/* Determine rows and columns to be interchanged and whether
a 1-by-1 or 2-by-2 pivot block will be used */
/* Determine rows and columns to be interchanged and whether */
/* a 1-by-1 or 2-by-2 pivot block will be used */
absakk = (d__1 = w[k + kw * w_dim1], abs(d__1));
/* IMAX is the row-index of the largest off-diagonal element in
column K, and COLMAX is its absolute value */
/* IMAX is the row-index of the largest off-diagonal element in */
/* column K, and COLMAX is its absolute value */
if (k > 1) {
i__1 = k - 1;
@@ -215,8 +246,8 @@ L10:
ldw, &c_b9, &w[(kw - 1) * w_dim1 + 1], &c__1);
}
/* JMAX is the column-index of the largest off-diagonal
element in row IMAX, and ROWMAX is its absolute value */
/* JMAX is the column-index of the largest off-diagonal */
/* element in row IMAX, and ROWMAX is its absolute value */
i__1 = k - imax;
jmax = imax + idamax_(&i__1, &w[imax + 1 + (kw - 1) * w_dim1],
@@ -239,8 +270,8 @@ L10:
} else if ((d__1 = w[imax + (kw - 1) * w_dim1], abs(d__1)) >=
alpha * rowmax) {
/* interchange rows and columns K and IMAX, use 1-by-1
pivot block */
/* interchange rows and columns K and IMAX, use 1-by-1 */
/* pivot block */
kp = imax;
@@ -250,8 +281,8 @@ L10:
w_dim1 + 1], &c__1);
} else {
/* interchange rows and columns K-1 and IMAX, use 2-by-2
pivot block */
/* interchange rows and columns K-1 and IMAX, use 2-by-2 */
/* pivot block */
kp = imax;
kstep = 2;
@@ -286,13 +317,13 @@ L10:
if (kstep == 1) {
/* 1-by-1 pivot block D(k): column KW of W now holds
/* 1-by-1 pivot block D(k): column KW of W now holds */
W(k) = U(k)*D(k)
/* W(k) = U(k)*D(k) */
where U(k) is the k-th column of U
/* where U(k) is the k-th column of U */
Store U(k) in column k of A */
/* Store U(k) in column k of A */
dcopy_(&k, &w[kw * w_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &
c__1);
@@ -301,13 +332,13 @@ L10:
dscal_(&i__1, &r1, &a[k * a_dim1 + 1], &c__1);
} else {
/* 2-by-2 pivot block D(k): columns KW and KW-1 of W now
hold
/* 2-by-2 pivot block D(k): columns KW and KW-1 of W now */
/* hold */
( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
/* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k) */
where U(k) and U(k-1) are the k-th and (k-1)-th columns
of U */
/* where U(k) and U(k-1) are the k-th and (k-1)-th columns */
/* of U */
if (k > 2) {
@@ -352,11 +383,11 @@ L10:
L30:
/* Update the upper triangle of A11 (= A(1:k,1:k)) as
/* Update the upper triangle of A11 (= A(1:k,1:k)) as */
A11 := A11 - U12*D*U12' = A11 - U12*W'
/* A11 := A11 - U12*D*U12' = A11 - U12*W' */
computing blocks of NB columns at a time */
/* computing blocks of NB columns at a time */
i__1 = -(*nb);
for (j = (k - 1) / *nb * *nb + 1; i__1 < 0 ? j >= 1 : j <= 1; j +=
@@ -387,8 +418,8 @@ L30:
/* L50: */
}
/* Put U12 in standard form by partially undoing the interchanges
in columns k+1:n */
/* Put U12 in standard form by partially undoing the interchanges */
/* in columns k+1:n */
j = k + 1;
L60:
@@ -413,11 +444,11 @@ L60:
} else {
/* Factorize the leading columns of A using the lower triangle
of A and working forwards, and compute the matrix W = L21*D
for use in updating A22
/* Factorize the leading columns of A using the lower triangle */
/* of A and working forwards, and compute the matrix W = L21*D */
/* for use in updating A22 */
K is the main loop index, increasing from 1 in steps of 1 or 2 */
/* K is the main loop index, increasing from 1 in steps of 1 or 2 */
k = 1;
L70:
@@ -439,13 +470,13 @@ L70:
kstep = 1;
/* Determine rows and columns to be interchanged and whether
a 1-by-1 or 2-by-2 pivot block will be used */
/* Determine rows and columns to be interchanged and whether */
/* a 1-by-1 or 2-by-2 pivot block will be used */
absakk = (d__1 = w[k + k * w_dim1], abs(d__1));
/* IMAX is the row-index of the largest off-diagonal element in
column K, and COLMAX is its absolute value */
/* IMAX is the row-index of the largest off-diagonal element in */
/* column K, and COLMAX is its absolute value */
if (k < *n) {
i__1 = *n - k;
@@ -485,8 +516,8 @@ L70:
lda, &w[imax + w_dim1], ldw, &c_b9, &w[k + (k + 1) *
w_dim1], &c__1);
/* JMAX is the column-index of the largest off-diagonal
element in row IMAX, and ROWMAX is its absolute value */
/* JMAX is the column-index of the largest off-diagonal */
/* element in row IMAX, and ROWMAX is its absolute value */
i__1 = imax - k;
jmax = k - 1 + idamax_(&i__1, &w[k + (k + 1) * w_dim1], &c__1)
@@ -510,8 +541,8 @@ L70:
} else if ((d__1 = w[imax + (k + 1) * w_dim1], abs(d__1)) >=
alpha * rowmax) {
/* interchange rows and columns K and IMAX, use 1-by-1
pivot block */
/* interchange rows and columns K and IMAX, use 1-by-1 */
/* pivot block */
kp = imax;
@@ -522,8 +553,8 @@ L70:
w_dim1], &c__1);
} else {
/* interchange rows and columns K+1 and IMAX, use 2-by-2
pivot block */
/* interchange rows and columns K+1 and IMAX, use 2-by-2 */
/* pivot block */
kp = imax;
kstep = 2;
@@ -554,13 +585,13 @@ L70:
if (kstep == 1) {
/* 1-by-1 pivot block D(k): column k of W now holds
/* 1-by-1 pivot block D(k): column k of W now holds */
W(k) = L(k)*D(k)
/* W(k) = L(k)*D(k) */
where L(k) is the k-th column of L
/* where L(k) is the k-th column of L */
Store L(k) in column k of A */
/* Store L(k) in column k of A */
i__1 = *n - k + 1;
dcopy_(&i__1, &w[k + k * w_dim1], &c__1, &a[k + k * a_dim1], &
@@ -572,12 +603,12 @@ L70:
}
} else {
/* 2-by-2 pivot block D(k): columns k and k+1 of W now hold
/* 2-by-2 pivot block D(k): columns k and k+1 of W now hold */
( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
/* ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k) */
where L(k) and L(k+1) are the k-th and (k+1)-th columns
of L */
/* where L(k) and L(k+1) are the k-th and (k+1)-th columns */
/* of L */
if (k < *n - 1) {
@@ -622,11 +653,11 @@ L70:
L90:
/* Update the lower triangle of A22 (= A(k:n,k:n)) as
/* Update the lower triangle of A22 (= A(k:n,k:n)) as */
A22 := A22 - L21*D*L21' = A22 - L21*W'
/* A22 := A22 - L21*D*L21' = A22 - L21*W' */
computing blocks of NB columns at a time */
/* computing blocks of NB columns at a time */
i__1 = *n;
i__2 = *nb;
@@ -659,8 +690,8 @@ L90:
/* L110: */
}
/* Put L21 in standard form by partially undoing the interchanges
in columns 1:k-1 */
/* Put L21 in standard form by partially undoing the interchanges */
/* in columns 1:k-1 */
j = k - 1;
L120:

View File

@@ -1,5 +1,18 @@
/* dlatrd.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_b5 = -1.;
@@ -31,7 +44,7 @@ static doublereal c_b16 = 0.;
doublereal *);
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */

View File

@@ -1,5 +1,18 @@
/* dlauu2.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_b7 = 1.;
@@ -26,7 +39,7 @@ static integer c__1 = 1;
extern /* Subroutine */ int xerbla_(char *, 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 */

Some files were not shown because too many files have changed in this diff Show More