--- R-2.10.1/src/include/R_ext/BLAS.h.orig Tue Mar 25 13:26:20 2008 +++ R-2.10.1/src/include/R_ext/BLAS.h Sun Dec 27 05:54:54 2009 @@ -23,6 +23,7 @@ /* src/Makevars declare PKG_LIBS = $(BLAS_LIBS) $(FLIBS) */ #include /* for F77_... */ +#include #include /* for Rcomplex */ #ifdef __cplusplus @@ -33,329 +34,20 @@ #define BLAS_extern extern #endif -/* Double Precision Level 1 BLAS */ +/** undocumented but part of sunperf lib */ +/* +extern double dlange_ __P((const char*, const int*, const int*, const double*, const int*, double *)); +extern double zlange_ __P((const char*, const int*, const int*, const doublecomplex*, const int*, double *)); +*/ -BLAS_extern double /* DASUM - sum of absolute values of a one-dimensional array */ -F77_NAME(dasum)(const int *n, const double *dx, const int *incx); -BLAS_extern void /* DAXPY - replace y by alpha*x + y */ -F77_NAME(daxpy)(const int *n, const double *alpha, - const double *dx, const int *incx, - double *dy, const int *incy); -BLAS_extern void /* DCOPY - copy x to y */ -F77_NAME(dcopy)(const int *n, const double *dx, const int *incx, - double *dy, const int *incy); -BLAS_extern double /* DDOT - inner product of x and y */ -F77_NAME(ddot)(const int *n, const double *dx, const int *incx, - const double *dy, const int *incy); -BLAS_extern double /* DNRM2 - 2-norm of a vector */ -F77_NAME(dnrm2)(const int *n, const double *dx, const int *incx); -BLAS_extern void /* DROT - apply a Given's rotation */ -F77_NAME(drot)(const int *n, double *dx, const int *incx, - double *dy, const int *incy, const double *c, const double *s); -BLAS_extern void /* DROTG - generate a Given's rotation */ -F77_NAME(drotg)(const double *a, const double *b, double *c, double *s); -BLAS_extern void /* DROTM - apply a modified Given's rotation */ -F77_NAME(drotm)(const int *n, double *dx, const int *incx, - double *dy, const int *incy, const double *dparam); -BLAS_extern void /* DROTMG - generate a modified Given's rotation */ -F77_NAME(drotmg)(const double *dd1, const double *dd2, const double *dx1, - const double *dy1, double *param); -BLAS_extern void /* DSCAL - scale a one-dimensional array */ -F77_NAME(dscal)(const int *n, const double *alpha, double *dx, const int *incx); -BLAS_extern void /* DSWAP - interchange one-dimensional arrays */ -F77_NAME(dswap)(const int *n, double *dx, const int *incx, - double *dy, const int *incy); -BLAS_extern int /* IDAMAX - return the index of the element with max abs value */ -F77_NAME(idamax)(const int *n, const double *dx, const int *incx); +/* #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX */ -/* Double Precision Level 2 BLAS */ - -/* DGBMV - perform one of the matrix-vector operations */ -/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, */ -BLAS_extern void -F77_NAME(dgbmv)(const char *trans, const int *m, const int *n, - const int *kl,const int *ku, - const double *alpha, const double *a, const int *lda, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); -/* DGEMV - perform one of the matrix-vector operations */ -/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, */ -BLAS_extern void -F77_NAME(dgemv)(const char *trans, const int *m, const int *n, - const double *alpha, const double *a, const int *lda, - const double *x, const int *incx, const double *beta, - double *y, const int *incy); -/* DSBMV - perform the matrix-vector operation */ -/* y := alpha*A*x + beta*y, */ -BLAS_extern void -F77_NAME(dsbmv)(const char *uplo, const int *n, const int *k, - const double *alpha, const double *a, const int *lda, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); -/* DSPMV - perform the matrix-vector operation */ -/* y := alpha*A*x + beta*y, */ -BLAS_extern void -F77_NAME(dspmv)(const char *uplo, const int *n, - const double *alpha, const double *ap, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); - -/* DSYMV - perform the matrix-vector operation */ -/* y := alpha*A*x + beta*y, */ -BLAS_extern void -F77_NAME(dsymv)(const char *uplo, const int *n, const double *alpha, - const double *a, const int *lda, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); -/* DTBMV - perform one of the matrix-vector operations */ -/* x := A*x, or x := A'*x, */ -BLAS_extern void -F77_NAME(dtbmv)(const char *uplo, const char *trans, - const char *diag, const int *n, const int *k, - const double *a, const int *lda, - double *x, const int *incx); -/* DTPMV - perform one of the matrix-vector operations */ -/* x := A*x, or x := A'*x, */ -BLAS_extern void -F77_NAME(dtpmv)(const char *uplo, const char *trans, const char *diag, - const int *n, const double *ap, - double *x, const int *incx); -/* DTRMV - perform one of the matrix-vector operations */ -/* x := A*x, or x := A'*x, */ -BLAS_extern void -F77_NAME(dtrmv)(const char *uplo, const char *trans, const char *diag, - const int *n, const double *a, const int *lda, - double *x, const int *incx); -/* DTBSV - solve one of the systems of equations */ -/* A*x = b, or A'*x = b, */ -BLAS_extern void -F77_NAME(dtbsv)(const char *uplo, const char *trans, - const char *diag, const int *n, const int *k, - const double *a, const int *lda, - double *x, const int *incx); -/* DTPSV - solve one of the systems of equations */ -/* A*x = b, or A'*x = b, */ -BLAS_extern void -F77_NAME(dtpsv)(const char *uplo, const char *trans, - const char *diag, const int *n, - const double *ap, double *x, const int *incx); -/* DTRSV - solve one of the systems of equations */ -/* A*x = b, or A'*x = b, */ -BLAS_extern void -F77_NAME(dtrsv)(const char *uplo, const char *trans, - const char *diag, const int *n, - const double *a, const int *lda, - double *x, const int *incx); -/* DGER - perform the rank 1 operation A := alpha*x*y' + A */ -BLAS_extern void -F77_NAME(dger)(const int *m, const int *n, const double *alpha, - double *x, const int *incx, - double *y, const int *incy, - double *a, const int *lda); -/* DSYR - perform the symmetric rank 1 operation A := alpha*x*x' + A */ -BLAS_extern void -F77_NAME(dsyr)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, - double *a, const int *lda); -/* DSPR - perform the symmetric rank 1 operation A := alpha*x*x' + A */ -BLAS_extern void -F77_NAME(dspr)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, double *ap); -/* DSYR2 - perform the symmetric rank 2 operation */ -/* A := alpha*x*y' + alpha*y*x' + A, */ -BLAS_extern void -F77_NAME(dsyr2)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, - const double *y, const int *incy, - double *a, const int *lda); -/* DSPR2 - perform the symmetric rank 2 operation */ -/* A := alpha*x*y' + alpha*y*x' + A, */ -BLAS_extern void -F77_NAME(dspr2)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, - const double *y, const int *incy, double *ap); - -/* Double Precision Level 3 BLAS */ - -/* DGEMM - perform one of the matrix-matrix operations */ -/* C := alpha*op( A )*op( B ) + beta*C */ -BLAS_extern void -F77_NAME(dgemm)(const char *transa, const char *transb, const int *m, - const int *n, const int *k, const double *alpha, - const double *a, const int *lda, - const double *b, const int *ldb, - const double *beta, double *c, const int *ldc); -/* DTRSM - solve one of the matrix equations */ -/* op(A)*X = alpha*B, or X*op(A) = alpha*B */ -BLAS_extern void -F77_NAME(dtrsm)(const char *side, const char *uplo, - const char *transa, const char *diag, - const int *m, const int *n, const double *alpha, - const double *a, const int *lda, - double *b, const int *ldb); -/* DTRMM - perform one of the matrix-matrix operations */ -/* B := alpha*op( A )*B, or B := alpha*B*op( A ) */ -BLAS_extern void -F77_NAME(dtrmm)(const char *side, const char *uplo, const char *transa, - const char *diag, const int *m, const int *n, - const double *alpha, const double *a, const int *lda, - double *b, const int *ldb); -/* DSYMM - perform one of the matrix-matrix operations */ -/* C := alpha*A*B + beta*C, */ -BLAS_extern void -F77_NAME(dsymm)(const char *side, const char *uplo, const int *m, - const int *n, const double *alpha, - const double *a, const int *lda, - const double *b, const int *ldb, - const double *beta, double *c, const int *ldc); -/* DSYRK - perform one of the symmetric rank k operations */ -/* C := alpha*A*A' + beta*C or C := alpha*A'*A + beta*C */ -BLAS_extern void -F77_NAME(dsyrk)(const char *uplo, const char *trans, - const int *n, const int *k, - const double *alpha, const double *a, const int *lda, - const double *beta, double *c, const int *ldc); -/* DSYR2K - perform one of the symmetric rank 2k operations */ -/* C := alpha*A*B' + alpha*B*A' + beta*C or */ -/* C := alpha*A'*B + alpha*B'*A + beta*C */ -BLAS_extern void -F77_NAME(dsyr2k)(const char *uplo, const char *trans, - const int *n, const int *k, - const double *alpha, const double *a, const int *lda, - const double *b, const int *ldb, - const double *beta, double *c, const int *ldc); +/** undocumented but part of sunperf lib */ /* - LSAME is a LAPACK support routine, not part of BLAS +extern doublecomplex zdotc_ __P((doublecomplex *res, int *n, doublecomplex *zx, int *incx, doublecomplex *zy, int *incy)); +extern doublecomplex zdotu_ __P((doublecomplex *res, int *n, doublecomplex *zx, int *incx, doublecomplex *zy, int *incy)); */ -/* Double complex BLAS routines added for 2.3.0 */ -/* #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX */ - BLAS_extern double - F77_NAME(dcabs1)(double *z); - BLAS_extern double - F77_NAME(dzasum)(int *n, Rcomplex *zx, int *incx); - BLAS_extern double - F77_NAME(dznrm2)(int *n, Rcomplex *x, int *incx); - BLAS_extern int - F77_NAME(izamax)(int *n, Rcomplex *zx, int *incx); - BLAS_extern void - F77_NAME(zaxpy)(int *n, Rcomplex *za, Rcomplex *zx, - int *incx, Rcomplex *zy, int *incy); - BLAS_extern void - F77_NAME(zcopy)(int *n, Rcomplex *zx, int *incx, - Rcomplex *zy, int *incy); - BLAS_extern Rcomplex - F77_NAME(zdotc)(Rcomplex * ret_val, int *n, - Rcomplex *zx, int *incx, Rcomplex *zy, int *incy); - BLAS_extern Rcomplex - F77_NAME(zdotu)(Rcomplex * ret_val, int *n, - Rcomplex *zx, int *incx, Rcomplex *zy, int *incy); - BLAS_extern void - F77_NAME(zdrot)(int *n, Rcomplex *zx, int *incx, Rcomplex *zy, - int *incy, double *c, double *s); - BLAS_extern void - F77_NAME(zdscal)(int *n, double *da, Rcomplex *zx, int *incx); - BLAS_extern void - F77_NAME(zgbmv)(char *trans, int *m, int *n, int *kl, - int *ku, Rcomplex *alpha, Rcomplex *a, int *lda, - Rcomplex *x, int *incx, Rcomplex *beta, Rcomplex *y, - int *incy); - BLAS_extern void - F77_NAME(zgemm)(const char *transa, const char *transb, const int *m, - const int *n, const int *k, const Rcomplex *alpha, - const Rcomplex *a, const int *lda, - const Rcomplex *b, const int *ldb, - const Rcomplex *beta, Rcomplex *c, const int *ldc); - BLAS_extern void - F77_NAME(zgemv)(char *trans, int *m, int *n, Rcomplex *alpha, - Rcomplex *a, int *lda, Rcomplex *x, int *incx, - Rcomplex *beta, Rcomplex *y, int * incy); - BLAS_extern void - F77_NAME(zgerc)(int *m, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zgeru)(int *m, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zhbmv)(char *uplo, int *n, int *k, Rcomplex *alpha, - Rcomplex *a, int *lda, Rcomplex *x, int *incx, - Rcomplex *beta, Rcomplex *y, int *incy); - BLAS_extern void - F77_NAME(zhemm)(char *side, char *uplo, int *m, int *n, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zhemv)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *a, - int *lda, Rcomplex *x, int *incx, Rcomplex *beta, - Rcomplex *y, int *incy); - BLAS_extern void - F77_NAME(zher)(char *uplo, int *n, double *alpha, Rcomplex *x, - int *incx, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zher2)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zher2k)(char *uplo, char *trans, int *n, int *k, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, double *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zherk)(char *uplo, char *trans, int *n, int *k, - double *alpha, Rcomplex *a, int *lda, double *beta, - Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zhpmv)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *ap, - Rcomplex *x, int *incx, Rcomplex * beta, Rcomplex *y, - int *incy); - BLAS_extern void - F77_NAME(zhpr)(char *uplo, int *n, double *alpha, - Rcomplex *x, int *incx, Rcomplex *ap); - BLAS_extern void - F77_NAME(zhpr2)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *ap); - BLAS_extern void - F77_NAME(zrotg)(Rcomplex *ca, Rcomplex *cb, double *c, Rcomplex *s); - BLAS_extern void - F77_NAME(zscal)(int *n, Rcomplex *za, Rcomplex *zx, int *incx); - BLAS_extern void - F77_NAME(zswap)(int *n, Rcomplex *zx, int *incx, Rcomplex *zy, int *incy); - BLAS_extern void - F77_NAME(zsymm)(char *side, char *uplo, int *m, int *n, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zsyr2k)(char *uplo, char *trans, int *n, int *k, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zsyrk)(char *uplo, char *trans, int *n, int *k, - Rcomplex *alpha, Rcomplex *a, int *lda, - Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(ztbmv)(char *uplo, char *trans, char *diag, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztbsv)(char *uplo, char *trans, char *diag, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztpmv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *ap, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztpsv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *ap, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztrmm)(char *side, char *uplo, char *transa, char *diag, - int *m, int *n, Rcomplex *alpha, Rcomplex *a, - int *lda, Rcomplex *b, int *ldb); - BLAS_extern void - F77_NAME(ztrmv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztrsm)(char *side, char *uplo, char *transa, char *diag, - int *m, int *n, Rcomplex *alpha, Rcomplex *a, - int *lda, Rcomplex *b, int *ldb); - BLAS_extern void - F77_NAME(ztrsv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); /* #endif */ #ifdef __cplusplus --- R-2.10.1/src/include/R_ext/Complex.h.orig Wed Sep 5 00:12:24 2007 +++ R-2.10.1/src/include/R_ext/Complex.h Mon Dec 28 06:24:53 2009 @@ -17,6 +17,7 @@ * along with this program; if not, a copy is available at * http://www.r-project.org/Licenses/ */ +#include #ifndef R_COMPLEX_H #define R_COMPLEX_H @@ -25,10 +26,7 @@ extern "C" { #endif -typedef struct { - double r; - double i; -} Rcomplex; +#define Rcomplex doublecomplex #ifdef __cplusplus } --- R-2.10.1/src/include/R_ext/RS.h.orig Wed Sep 5 00:12:24 2007 +++ R-2.10.1/src/include/R_ext/RS.h Sun Dec 27 06:36:56 2009 @@ -83,6 +83,10 @@ #define F77_COM(x) F77_CALL(x) #define F77_COMDECL(x) F77_CALL(x) +/* f77 C interface is not documented for sunperf - so we use C interface + wherever possible */ +#define SPL_CALL(x) x + void call_R(char*, long, void**, char**, long*, char**, long, char**); #ifdef __cplusplus --- R-2.10.1/src/include/Rgraphics.h.orig Mon Sep 22 00:05:06 2008 +++ R-2.10.1/src/include/Rgraphics.h Sun Dec 27 21:51:14 2009 @@ -39,7 +39,7 @@ OMA4 = 5, /* outer margin 4 (right) */ NFC = 7, /* normalised figure region coordinates (0,1) */ NPC = 16, /* normalised plot region coordinates (0,1) */ - USER = 12, /* user/data/world coordinates; + USERC = 12, /* user/data/world coordinates; * x,=(xmin,xmax), y=(ymin,ymax) */ MAR1 = 8, /* figure margin 1 (bottom) x=USER(x), y=LINES */ MAR2 = 9, /* figure margin 2 (left) x=USER(y), y=LINES */ --- R-2.10.1/src/main/array.c.orig Fri May 22 17:00:36 2009 +++ R-2.10.1/src/main/array.c Sun Dec 27 21:44:45 2009 @@ -416,7 +416,7 @@ static void matprod(double *x, int nrx, int ncx, double *y, int nry, int ncy, double *z) { - char *transa = "N", *transb = "N"; + char transa = 'N', transb = 'N'; int i, j, k; double one = 1.0, zero = 0.0; LDOUBLE sum; @@ -440,8 +440,8 @@ z[i + k * nrx] = sum; } } else - F77_CALL(dgemm)(transa, transb, &nrx, &ncy, &ncx, &one, - x, &nrx, y, &nry, &zero, z, &nrx); + SPL_CALL(dgemm)(transa, transb, nrx, ncy, ncx, one, + x, nrx, y, nry, zero, z, nrx); } else /* zero-extent operations should return zeroes */ for(i = 0; i < nrx*ncy; i++) z[i] = 0; } @@ -450,14 +450,13 @@ Rcomplex *y, int nry, int ncy, Rcomplex *z) { #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX - char *transa = "N", *transb = "N"; int i; Rcomplex one, zero; one.r = 1.0; one.i = zero.r = zero.i = 0.0; if (nrx > 0 && ncx > 0 && nry > 0 && ncy > 0) { - F77_CALL(zgemm)(transa, transb, &nrx, &ncy, &ncx, &one, - x, &nrx, y, &nry, &zero, z, &nrx); + SPL_CALL(zgemm)('N', 'N', nrx, ncy, ncx, &one, + x, nrx, y, nry, &zero, z, nrx); } else { /* zero-extent operations should return zeroes */ for(i = 0; i < nrx*ncy; i++) z[i].r = z[i].i = 0; } @@ -493,11 +492,10 @@ static void symcrossprod(double *x, int nr, int nc, double *z) { - char *trans = "T", *uplo = "U"; double one = 1.0, zero = 0.0; int i, j; if (nr > 0 && nc > 0) { - F77_CALL(dsyrk)(uplo, trans, &nc, &nr, &one, x, &nr, &zero, z, &nc); + SPL_CALL(dsyrk)('U', 'T', nc, nr, one, x, nr, zero, z, nc); for (i = 1; i < nc; i++) for (j = 0; j < i; j++) z[i + nc *j] = z[j + nc * i]; } else { /* zero-extent operations should return zeroes */ @@ -509,11 +507,10 @@ static void crossprod(double *x, int nrx, int ncx, double *y, int nry, int ncy, double *z) { - char *transa = "T", *transb = "N"; double one = 1.0, zero = 0.0; if (nrx > 0 && ncx > 0 && nry > 0 && ncy > 0) { - F77_CALL(dgemm)(transa, transb, &ncx, &ncy, &nrx, &one, - x, &nrx, y, &nry, &zero, z, &ncx); + SPL_CALL(dgemm)('T', 'N', ncx, ncy, nrx, one, + x, nrx, y, nry, zero, z, ncx); } else { /* zero-extent operations should return zeroes */ int i; for(i = 0; i < ncx*ncy; i++) z[i] = 0; @@ -523,13 +520,12 @@ static void ccrossprod(Rcomplex *x, int nrx, int ncx, Rcomplex *y, int nry, int ncy, Rcomplex *z) { - char *transa = "T", *transb = "N"; Rcomplex one, zero; one.r = 1.0; one.i = zero.r = zero.i = 0.0; if (nrx > 0 && ncx > 0 && nry > 0 && ncy > 0) { - F77_CALL(zgemm)(transa, transb, &ncx, &ncy, &nrx, &one, - x, &nrx, y, &nry, &zero, z, &ncx); + SPL_CALL(zgemm)('T', 'N', ncx, ncy, nrx, &one, + x, nrx, y, nry, &zero, z, ncx); } else { /* zero-extent operations should return zeroes */ int i; for(i = 0; i < ncx*ncy; i++) z[i].r = z[i].i = 0; @@ -538,11 +534,10 @@ static void symtcrossprod(double *x, int nr, int nc, double *z) { - char *trans = "N", *uplo = "U"; double one = 1.0, zero = 0.0; int i, j; if (nr > 0 && nc > 0) { - F77_CALL(dsyrk)(uplo, trans, &nr, &nc, &one, x, &nr, &zero, z, &nr); + SPL_CALL(dsyrk)('U', 'N', nr, nc, one, x, nr, zero, z, nr); for (i = 1; i < nr; i++) for (j = 0; j < i; j++) z[i + nr *j] = z[j + nr * i]; } else { /* zero-extent operations should return zeroes */ @@ -554,11 +549,9 @@ static void tcrossprod(double *x, int nrx, int ncx, double *y, int nry, int ncy, double *z) { - char *transa = "N", *transb = "T"; double one = 1.0, zero = 0.0; if (nrx > 0 && ncx > 0 && nry > 0 && ncy > 0) { - F77_CALL(dgemm)(transa, transb, &nrx, &nry, &ncx, &one, - x, &nrx, y, &nry, &zero, z, &nrx); + SPL_CALL(dgemm)('N', 'T', nrx, nry, ncx, one, x, nrx, y, nry, zero, z, nrx); } else { /* zero-extent operations should return zeroes */ int i; for(i = 0; i < nrx*nry; i++) z[i] = 0; @@ -568,13 +561,12 @@ static void tccrossprod(Rcomplex *x, int nrx, int ncx, Rcomplex *y, int nry, int ncy, Rcomplex *z) { - char *transa = "N", *transb = "T"; Rcomplex one, zero; one.r = 1.0; one.i = zero.r = zero.i = 0.0; if (nrx > 0 && ncx > 0 && nry > 0 && ncy > 0) { - F77_CALL(zgemm)(transa, transb, &nrx, &nry, &ncx, &one, - x, &nrx, y, &nry, &zero, z, &nrx); + SPL_CALL(zgemm)('N', 'T', nrx, nry, ncx, &one, + x, nrx, y, nry, &zero, z, nrx); } else { /* zero-extent operations should return zeroes */ int i; for(i = 0; i < nrx*nry; i++) z[i].r = z[i].i = 0; --- R-2.10.1/src/appl/bakslv.c.orig Wed Sep 5 00:13:32 2007 +++ R-2.10.1/src/appl/bakslv.c Sun Dec 27 06:51:18 2009 @@ -94,7 +94,7 @@ * blas: dcopy * blas3: dtrsm */ - char *side = "L", *uplo, *transa, *diag = "N"; + char side = 'L', uplo, transa, diag = 'N'; int i, ione = 1, j, nn = *n; double one = 1.0; @@ -106,13 +106,13 @@ } } for(j = 0; j < *nb; j++) { /* copy b to x */ - F77_CALL(dcopy)(n, &b[j * *ldb], &ione, &x[j * *ldb], &ione); + SPL_CALL(dcopy)(*n, &b[j * *ldb], ione, &x[j * *ldb], ione); } - transa = ((*job) / 10) ? "T" : "N"; - uplo = ((*job) % 10) ? "U" : "L"; + transa = ((*job) / 10) ? 'T' : 'N'; + uplo = ((*job) % 10) ? 'U' : 'L'; if (*n > 0 && *nb > 0 && *ldt > 0 && *ldb > 0) { - F77_CALL(dtrsm)(side, uplo, transa, diag, n, nb, &one, - t, ldt, x, ldb); + SPL_CALL(dtrsm)(side, uplo, transa, diag, *n, *nb, one, + t, *ldt, x, *ldb); } } --- R-2.10.1/src/main/graphics.c.orig Mon Sep 28 00:05:39 2009 +++ R-2.10.1/src/main/graphics.c Sun Dec 27 21:58:19 2009 @@ -106,7 +106,7 @@ GUnit GMapUnits(int Runits) { switch (Runits) { - case 1: return USER; + case 1: return USERC; case 2: return NFC; case 3: return INCHES; default: return 0; @@ -299,7 +299,7 @@ case NIC: dev = xNICtoDevUnits(x, dd); break; case NFC: dev = xNFCtoDevUnits(x, dd); break; case NPC: dev = xNPCtoDevUnits(x, dd); break; - case USER: dev = xUsrtoDevUnits(x, dd); break; + case USERC: dev = xUsrtoDevUnits(x, dd); break; case INCHES: dev = xInchtoDevUnits(x, dd); break; case LINES: dev = xLinetoDevUnits(x, dd); break; case CHARS: dev = xChartoDevUnits(x, dd); break; @@ -312,7 +312,7 @@ case NIC: final = xDevtoNICUnits(dev, dd); break; case NFC: final = xDevtoNFCUnits(dev, dd); break; case NPC: final = xDevtoNPCUnits(dev, dd); break; - case USER: final = xDevtoUsrUnits(dev, dd); break; + case USERC: final = xDevtoUsrUnits(dev, dd); break; case INCHES: final = xDevtoInchUnits(dev, dd); break; case LINES: final = xDevtoLineUnits(dev, dd); break; case CHARS: final = xDevtoCharUnits(dev, dd); break; @@ -330,7 +330,7 @@ case NIC: dev = yNICtoDevUnits(y, dd); break; case NFC: dev = yNFCtoDevUnits(y, dd); break; case NPC: dev = yNPCtoDevUnits(y, dd); break; - case USER: dev = yUsrtoDevUnits(y, dd); break; + case USERC: dev = yUsrtoDevUnits(y, dd); break; case INCHES: dev = yInchtoDevUnits(y, dd); break; case LINES: dev = yLinetoDevUnits(y, dd); break; case CHARS: dev = yChartoDevUnits(y, dd); break; @@ -342,7 +342,7 @@ case NIC: final = yDevtoNICUnits(dev, dd); break; case NFC: final = yDevtoNFCUnits(dev, dd); break; case NPC: final = yDevtoNPCUnits(dev, dd); break; - case USER: final = yDevtoUsrUnits(dev, dd); break; + case USERC: final = yDevtoUsrUnits(dev, dd); break; case INCHES: final = yDevtoInchUnits(dev, dd); break; case LINES: final = yDevtoLineUnits(dev, dd); break; case CHARS: final = yDevtoCharUnits(dev, dd); break; @@ -776,7 +776,7 @@ devx = xNPCtoDev(*x, dd); devy = yNPCtoDev(*y, dd); break; - case USER: + case USERC: devx = xUsrtoDev(*x, dd); devy = yUsrtoDev(*y, dd); break; @@ -831,7 +831,7 @@ *x = xDevtoNPC(devx, dd); *y = yDevtoNPC(devy, dd); break; - case USER: + case USERC: *x = xDevtoUsr(devx, dd); *y = yDevtoUsr(devy, dd); break; @@ -875,7 +875,7 @@ case MAR3: devx = xMAR3toDev(x, dd); break; /*case MAR4: x <--> y */ case NPC: devx = xNPCtoDev(x, dd); break; - case USER: devx = xUsrtoDev(x, dd); break; + case USERC: devx = xUsrtoDev(x, dd); break; default: devx = 0;/* for -Wall */ BadUnitsError("GConvertX"); } @@ -890,7 +890,7 @@ case OMA3: x = xDevtoOMA3(devx, dd); break; /*case OMA4: x <--> y */ case NFC: x = xDevtoNFC(devx, dd); break; - case USER: x = xDevtoUsr(devx, dd); break; + case USERC: x = xDevtoUsr(devx, dd); break; case MAR1: x = xDevtoMAR1(devx, dd); break; /*case MAR2: x <--> y */ case MAR3: x = xDevtoMAR3(devx, dd); break; @@ -920,7 +920,7 @@ case MAR3: devy = yMAR3toDev(y, dd); break; /*case MAR4: x <--> y */ case NPC: devy = yNPCtoDev(y, dd); break; - case USER: devy = yUsrtoDev(y, dd); break; + case USERC: devy = yUsrtoDev(y, dd); break; default: devy = 0;/* for -Wall */ BadUnitsError("GConvertY"); } @@ -935,7 +935,7 @@ case OMA3: y = yDevtoOMA3(devy, dd); break; /*case OMA4: x <--> y */ case NFC: y = yDevtoNFC(devy, dd); break; - case USER: y = yDevtoUsr(devy, dd); break; + case USERC: y = yDevtoUsr(devy, dd); break; case MAR1: y = yDevtoMAR1(devy, dd); break; /*case MAR2: x <--> y */ case MAR3: y = yDevtoMAR3(devy, dd); break; @@ -3204,7 +3204,7 @@ case 3: coords = MAR3; break; case 4: coords = MAR4; break; } - subcoords = USER; + subcoords = USERC; } /* Note: I changed gpptr(dd)->yLineBias to 0.3 here. */ /* Purely visual tuning. RI */ @@ -3345,7 +3345,7 @@ case 3: coords = MAR3; break; case 4: coords = MAR4; break; } - subcoords = USER; + subcoords = USERC; } switch(side) { case 1: --- R-2.10.1/src/appl/lbfgsb.c.orig Wed Sep 5 00:13:32 2007 +++ R-2.10.1/src/appl/lbfgsb.c Mon Dec 28 20:29:34 2009 @@ -742,8 +742,8 @@ if (strncmp(task, "STOP", 4) == 0) { if (strncmp(task + 6, "CPU", 3) == 0) { /* restore the previous iterate. */ - F77_CALL(dcopy)(&n, &t[1], &c__1, &x[1], &c__1); - F77_CALL(dcopy)(&n, &r[1], &c__1, &g[1], &c__1); + SPL_CALL(dcopy)(n, &t[1], c__1, &x[1], c__1); + SPL_CALL(dcopy)(n, &r[1], c__1, &g[1], c__1); *f = fold; } goto L999; @@ -774,7 +774,7 @@ if (! cnstnd && col > 0) { /* skip the search for GCP. */ - F77_CALL(dcopy)(&n, &x[1], &c__1, &z[1], &c__1); + SPL_CALL(dcopy)(n, &x[1], c__1, &z[1], c__1); wrk = updatd; nint = 0; goto L333; @@ -903,8 +903,8 @@ csave, &isave[22], &dsave[17]); if (info != 0 || iback >= 20) { /* restore the previous iterate. */ - F77_CALL(dcopy)(&n, &t[1], &c__1, &x[1], &c__1); - F77_CALL(dcopy)(&n, &r[1], &c__1, &g[1], &c__1); + SPL_CALL(dcopy)(n, &t[1], c__1, &x[1], c__1); + SPL_CALL(dcopy)(n, &r[1], c__1, &g[1], c__1); *f = fold; if (col == 0) { /* abnormal termination. */ @@ -975,13 +975,13 @@ r[i] = g[i] - r[i]; /* L42: */ } - rr = F77_CALL(ddot)(&n, &r[1], &c__1, &r[1], &c__1); + rr = SPL_CALL(ddot)(n, &r[1], c__1, &r[1], c__1); if (stp == 1.) { dr = gd - gdold; ddum = -gdold; } else { dr = (gd - gdold) * stp; - F77_CALL(dscal)(&n, &stp, &d[1], &c__1); + SPL_CALL(dscal)(n, stp, &d[1], c__1); ddum = -gdold * stp; } if (dr <= epsmch * ddum) { @@ -1532,7 +1532,7 @@ if (*sbgnrm <= 0.) { if (iprint >= 0) Rprintf("Subgnorm = 0. GCP = X.\n"); - F77_CALL(dcopy)(&n, &x[1], &c__1, &xcp[1], &c__1); + SPL_CALL(dcopy)(n, &x[1], c__1, &xcp[1], c__1); return; } bnded = TRUE_; @@ -1630,10 +1630,10 @@ /* The smallest of the nbreak breakpoints is in t(ibkmin)=bkmin. */ if (*theta != 1.) { /* complete the initialization of p for theta not= one. */ - F77_CALL(dscal)(col, theta, &p[*col + 1], &c__1); + SPL_CALL(dscal)(*col, *theta, &p[*col + 1], c__1); } /* Initialize GCP xcp = x. */ - F77_CALL(dcopy)(&n, &x[1], &c__1, &xcp[1], &c__1); + SPL_CALL(dcopy)(n, &x[1], c__1, &xcp[1], c__1); if (nbreak == 0 && nfree == n + 1) { /* is a zero vector, return with the initial xcp as GCP. */ if (iprint > 100) { @@ -1655,7 +1655,7 @@ if (*info != 0) { return; } - f2 -= F77_CALL(ddot)(&col2, &v[1], &c__1, &p[1], &c__1); + f2 -= SPL_CALL(ddot)(col2, &v[1], c__1, &p[1], c__1); } dtm = -f1 / f2; tsum = 0.; @@ -1741,7 +1741,7 @@ f2 -= *theta * dibp2; if (*col > 0) { /* update c = c + dt*p. */ - F77_CALL(daxpy)(&col2, &dt, &p[1], &c__1, &c[1], &c__1); + SPL_CALL(daxpy)(col2, dt, &p[1], c__1, &c[1], c__1); /* choose wbp, */ /* the row of W corresponding to the breakpoint encountered. */ pointr = *head; @@ -1755,12 +1755,12 @@ if (*info != 0) { return; } - wmc = F77_CALL(ddot)(&col2, &c[1], &c__1, &v[1], &c__1); - wmp = F77_CALL(ddot)(&col2, &p[1], &c__1, &v[1], &c__1); - wmw = F77_CALL(ddot)(&col2,&wbp[1], &c__1, &v[1], &c__1); + wmc = SPL_CALL(ddot)(col2, &c[1], c__1, &v[1], c__1); + wmp = SPL_CALL(ddot)(col2, &p[1], c__1, &v[1], c__1); + wmw = SPL_CALL(ddot)(col2,&wbp[1], c__1, &v[1], c__1); /* update p = p - dibp*wbp. */ d__1 = -dibp; - F77_CALL(daxpy)(&col2, &d__1, &wbp[1], &c__1, &p[1], &c__1); + SPL_CALL(daxpy)(col2, d__1, &wbp[1], c__1, &p[1], c__1); /* complete updating f1 and f2 while col > 0. */ f1 += dibp * wmc; f2 += (2. * dibp * wmp - dibp2 * wmw); @@ -1792,12 +1792,12 @@ tsum += dtm; /* Move free variables (i.e., the ones w/o breakpoints) and */ /* the variables whose breakpoints haven't been reached. */ - F77_CALL(daxpy)(&n, &tsum, &d[1], &c__1, &xcp[1], &c__1); + SPL_CALL(daxpy)(n, tsum, &d[1], c__1, &xcp[1], c__1); L999: /* Update c = c + dtm*p = W'(x^c - x) */ /* which will be used in computing r = Z'(B(x^c - x) + g). */ if (*col > 0) { - F77_CALL(daxpy)(&col2, &dtm, &p[1], &c__1, &c[1], &c__1); + SPL_CALL(daxpy)(col2, dtm, &p[1], c__1, &c[1], c__1); } if (iprint >= 100) { Rprintf("Cauchy X = "); @@ -2135,13 +2135,13 @@ for (jy = 1; jy <= i__1; ++jy) { js = m + jy; i__2 = m - jy; - F77_CALL(dcopy)(&i__2, &wn1[jy + 1 + (jy + 1)* wn1_dim1], &c__1, - &wn1[jy + jy * wn1_dim1], &c__1); - F77_CALL(dcopy)(&i__2, &wn1[js + 1 + (js + 1)* wn1_dim1], &c__1, - &wn1[js + js * wn1_dim1], &c__1); + SPL_CALL(dcopy)(i__2, &wn1[jy + 1 + (jy + 1)* wn1_dim1], c__1, + &wn1[jy + jy * wn1_dim1], c__1); + SPL_CALL(dcopy)(i__2, &wn1[js + 1 + (js + 1)* wn1_dim1], c__1, + &wn1[js + js * wn1_dim1], c__1); i__2 = m - 1; - F77_CALL(dcopy)(&i__2, &wn1[m + 2 + (jy + 1) * wn1_dim1], &c__1, - &wn1[m + 1 + jy * wn1_dim1], &c__1); + SPL_CALL(dcopy)(i__2, &wn1[m + 2 + (jy + 1) * wn1_dim1], c__1, + &wn1[m + 1 + jy * wn1_dim1], c__1); /* L10: */ } } @@ -2307,8 +2307,8 @@ for (is = *col + 1; is <= col2; ++is) { for (js = is; js <= col2; ++js) { wn[is + js * wn_dim1] += - F77_CALL(ddot)(col, &wn[is * wn_dim1 + 1], &c__1, - &wn[js * wn_dim1 + 1], &c__1); + SPL_CALL(ddot)(*col, &wn[is * wn_dim1 + 1], c__1, + &wn[js * wn_dim1 + 1], c__1); } /* L72: */ } @@ -2679,7 +2679,7 @@ if (strncmp(task, "FG_LN", 5) == 0) { goto L556; } - *dtd = F77_CALL(ddot)(&n, &d[1], &c__1, &d[1], &c__1); + *dtd = SPL_CALL(ddot)(n, &d[1], c__1, &d[1], c__1); *dnorm = sqrt(*dtd); /* Determine the maximum step length. */ *stpmx = 1e10; @@ -2716,14 +2716,14 @@ } else { *stp = 1.; } - F77_CALL(dcopy)(&n, &x[1], &c__1, &t[1], &c__1); - F77_CALL(dcopy)(&n, &g[1], &c__1, &r[1], &c__1); + SPL_CALL(dcopy)(n, &x[1], c__1, &t[1], c__1); + SPL_CALL(dcopy)(n, &g[1], c__1, &r[1], c__1); *fold = *f; *ifun = 0; *iback = 0; strcpy(csave, "START"); L556: - *gd = F77_CALL(ddot)(&n, &g[1], &c__1, &d[1], &c__1); + *gd = SPL_CALL(ddot)(n, &g[1], c__1, &d[1], c__1); if (*ifun == 0) { *gdold = *gd; if (*gd >= 0.) { @@ -2744,7 +2744,7 @@ ++(*nfgv); *iback = *ifun - 1; if (*stp == 1.) { - F77_CALL(dcopy)(&n, &z[1], &c__1, &x[1], &c__1); + SPL_CALL(dcopy)(n, &z[1], c__1, &x[1], c__1); } else { for (i = 1; i <= n; ++i) { x[i] = *stp * d[i] + t[i]; @@ -2822,8 +2822,8 @@ *head = *head % m + 1; } /* Update matrices WS and WY. */ - F77_CALL(dcopy)(&n, &d[1], &c__1, &ws[*itail * ws_dim1 + 1], &c__1); - F77_CALL(dcopy)(&n, &r[1], &c__1, &wy[*itail * wy_dim1 + 1], &c__1); + SPL_CALL(dcopy)(n, &d[1], c__1, &ws[*itail * ws_dim1 + 1], c__1); + SPL_CALL(dcopy)(n, &r[1], c__1, &wy[*itail * wy_dim1 + 1], c__1); /* Set theta=yy/ys. */ *theta = *rr / *dr; /* Form the middle matrix in B. */ @@ -2833,11 +2833,11 @@ /* move old information */ i__1 = *col - 1; for (j = 1; j <= i__1; ++j) { - F77_CALL(dcopy)(&j, &ss[(j + 1) * ss_dim1 + 2], &c__1, - &ss[j * ss_dim1 + 1], &c__1); + SPL_CALL(dcopy)(j, &ss[(j + 1) * ss_dim1 + 2], c__1, + &ss[j * ss_dim1 + 1], c__1); i__2 = *col - j; - F77_CALL(dcopy)(&i__2, &sy[j + 1 + (j + 1) * sy_dim1], &c__1, - &sy[j + j * sy_dim1], &c__1); + SPL_CALL(dcopy)(i__2, &sy[j + 1 + (j + 1) * sy_dim1], c__1, + &sy[j + j * sy_dim1], c__1); /* L50: */ } } @@ -2847,9 +2847,9 @@ i__1 = *col - 1; for (j = 1; j <= i__1; ++j) { sy[*col + j * sy_dim1] = - F77_CALL(ddot)(&n, &d[1], &c__1, &wy[pointr * wy_dim1 + 1], &c__1); + SPL_CALL(ddot)(n, &d[1], c__1, &wy[pointr * wy_dim1 + 1], c__1); ss[j + *col * ss_dim1] = - F77_CALL(ddot)(&n, &ws[pointr * ws_dim1 + 1], &c__1, &d[1], &c__1); + SPL_CALL(ddot)(n, &ws[pointr * ws_dim1 + 1], c__1, &d[1], c__1); pointr = pointr % m + 1; /* L51: */ } --- R-2.10.1/src/main/plot.c.orig Fri Nov 20 15:03:34 2009 +++ R-2.10.1/src/main/plot.c Sun Dec 27 22:06:58 2009 @@ -855,12 +855,12 @@ x[1] = gpptr(dd)->usr[1]; break; case 1: - x[0] = GConvertX(0, NFC, USER, dd); - x[1] = GConvertX(1, NFC, USER, dd); + x[0] = GConvertX(0, NFC, USERC, dd); + x[1] = GConvertX(1, NFC, USERC, dd); break; case 2: - x[0] = GConvertX(0, NDC, USER, dd); - x[1] = GConvertX(1, NDC, USER, dd); + x[0] = GConvertX(0, NDC, USERC, dd); + x[1] = GConvertX(1, NDC, USERC, dd); break; } } @@ -872,12 +872,12 @@ y[1] = gpptr(dd)->usr[3]; break; case 1: - y[0] = GConvertY(0, NFC, USER, dd); - y[1] = GConvertY(1, NFC, USER, dd); + y[0] = GConvertY(0, NFC, USERC, dd); + y[1] = GConvertY(1, NFC, USERC, dd); break; case 2: - y[0] = GConvertY(0, NDC, USER, dd); - y[1] = GConvertY(1, NDC, USER, dd); + y[0] = GConvertY(0, NDC, USERC, dd); + y[1] = GConvertY(1, NDC, USERC, dd); break; } } @@ -1139,11 +1139,11 @@ /* Now override par("xpd") and force clipping to device region. */ gpptr(dd)->xpd = 2; GetAxisLimits(limits[0], limits[1], &low, &high); - axis_low = GConvertX(fmin2(high, fmax2(low, REAL(at)[0])), USER, NFC, dd); - axis_high = GConvertX(fmin2(high, fmax2(low, REAL(at)[n-1])), USER, NFC, dd); + axis_low = GConvertX(fmin2(high, fmax2(low, REAL(at)[0])), USERC, NFC, dd); + axis_high = GConvertX(fmin2(high, fmax2(low, REAL(at)[n-1])), USERC, NFC, dd); if (side == 1) { if (R_FINITE(pos)) - axis_base = GConvertY(pos, USER, NFC, dd); + axis_base = GConvertY(pos, USERC, NFC, dd); else axis_base = GConvertY(0.0, outer, NFC, dd) - GConvertYUnits(line, LINES, NFC, dd); @@ -1165,7 +1165,7 @@ } else { if (R_FINITE(pos)) - axis_base = GConvertY(pos, USER, NFC, dd); + axis_base = GConvertY(pos, USERC, NFC, dd); else axis_base = GConvertY(1.0, outer, NFC, dd) + GConvertYUnits(line, LINES, NFC, dd); @@ -1194,7 +1194,7 @@ for (i = 0; i < n; i++) { x = REAL(at)[i]; if (low <= x && x <= high) { - x = GConvertX(x, USER, NFC, dd); + x = GConvertX(x, USERC, NFC, dd); GLine(x, axis_base, x, axis_tick, NFC, dd); } } @@ -1242,7 +1242,7 @@ padjval = ComputePAdjValue(padjval, side, gpptr(dd)->las); x = REAL(at)[i]; if (!R_FINITE(x)) continue; - temp = GConvertX(x, USER, NFC, dd); + temp = GConvertX(x, USERC, NFC, dd); if (dolabels) { /* Clip tick labels to user coordinates. */ if (x > low && x < high) { @@ -1280,11 +1280,11 @@ /* Now override par("xpd") and force clipping to device region. */ gpptr(dd)->xpd = 2; GetAxisLimits(limits[0], limits[1], &low, &high); - axis_low = GConvertY(fmin2(high, fmax2(low, REAL(at)[0])), USER, NFC, dd); - axis_high = GConvertY(fmin2(high, fmax2(low, REAL(at)[n-1])), USER, NFC, dd); + axis_low = GConvertY(fmin2(high, fmax2(low, REAL(at)[0])), USERC, NFC, dd); + axis_high = GConvertY(fmin2(high, fmax2(low, REAL(at)[n-1])), USERC, NFC, dd); if (side == 2) { if (R_FINITE(pos)) - axis_base = GConvertX(pos, USER, NFC, dd); + axis_base = GConvertX(pos, USERC, NFC, dd); else axis_base = GConvertX(0.0, outer, NFC, dd) - GConvertXUnits(line, LINES, NFC, dd); @@ -1305,7 +1305,7 @@ } else { if (R_FINITE(pos)) - axis_base = GConvertX(pos, USER, NFC, dd); + axis_base = GConvertX(pos, USERC, NFC, dd); else axis_base = GConvertX(1.0, outer, NFC, dd) + GConvertXUnits(line, LINES, NFC, dd); @@ -1334,7 +1334,7 @@ for (i = 0; i < n; i++) { y = REAL(at)[i]; if (low <= y && y <= high) { - y = GConvertY(y, USER, NFC, dd); + y = GConvertY(y, USERC, NFC, dd); GLine(axis_base, y, axis_tick, y, NFC, dd); } } @@ -1383,7 +1383,7 @@ padjval = ComputePAdjValue(padjval, side, gpptr(dd)->las); y = REAL(at)[i]; if (!R_FINITE(y)) continue; - temp = GConvertY(y, USER, NFC, dd); + temp = GConvertY(y, USERC, NFC, dd); if (dolabels) { /* Clip tick labels to user coordinates. */ if (y > low && y < high) { @@ -1536,7 +1536,7 @@ xx = x[i]; yy = y[i]; /* do the conversion now to check for non-finite */ - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); if ((R_FINITE(xx) && R_FINITE(yy)) && !(R_FINITE(xold) && R_FINITE(yold))) start = i; @@ -1543,10 +1543,10 @@ else if ((R_FINITE(xold) && R_FINITE(yold)) && !(R_FINITE(xx) && R_FINITE(yy))) { if (i-start > 1) - GPolyline(i-start, x+start, y+start, USER, dd); + GPolyline(i-start, x+start, y+start, USERC, dd); } else if ((R_FINITE(xold) && R_FINITE(yold)) && (i == n-1)) - GPolyline(n-start, x+start, y+start, USER, dd); + GPolyline(n-start, x+start, y+start, USERC, dd); xold = xx; yold = yy; } @@ -1563,7 +1563,7 @@ for (i = 0; i < n; i++) { xx = x[i]; yy = y[i]; - GConvert(&xx, &yy, USER, INCHES, dd); + GConvert(&xx, &yy, USERC, INCHES, dd); if (R_FINITE(xold) && R_FINITE(yold) && R_FINITE(xx) && R_FINITE(yy)) { if ((f = d/hypot(xx-xold, yy-yold)) < 0.5) { @@ -1599,7 +1599,7 @@ for (i = 0; i < n; i++) { xx = x[i]; yy = y[i]; - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); if ((R_FINITE(xx) && R_FINITE(yy)) && (R_FINITE(xold) && R_FINITE(yold))) { if(n0 == 0) { xtemp[n0] = xold; ytemp[n0++] = yold; } @@ -1637,7 +1637,7 @@ for (i = 0; i < n; i++) { xx = x[i]; yy = y[i]; - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); if ((R_FINITE(xx) && R_FINITE(yy)) && (R_FINITE(xold) && R_FINITE(yold))) { if(n0 == 0) {xtemp[n0] = xold; ytemp[n0++] = yold;} @@ -1661,11 +1661,11 @@ yold = gpptr(dd)->usr[2];/* DBL_MIN fails.. why ???? */ else yold = 0.0; - yold = GConvertY(yold, USER, DEVICE, dd); + yold = GConvertY(yold, USERC, DEVICE, dd); for (i = 0; i < n; i++) { xx = x[i]; yy = y[i]; - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); if (R_FINITE(xx) && R_FINITE(yy) && !R_TRANSPARENT(thiscol = INTEGER(col)[i % ncol])) { gpptr(dd)->col = thiscol; @@ -1688,7 +1688,7 @@ for (i = 0; i < n; i++) { xx = x[i]; yy = y[i]; - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); if (R_FINITE(xx) && R_FINITE(yy)) { if (R_FINITE( (thiscex = REAL(cex)[i % ncex]) ) && (thispch = INTEGER(pch)[i % npch]) != NA_INTEGER) { @@ -1803,8 +1803,8 @@ yy[0] = y0[i%ny0]; xx[1] = x1[i%nx1]; yy[1] = y1[i%ny1]; - GConvert(xx, yy, USER, DEVICE, dd); - GConvert(xx+1, yy+1, USER, DEVICE, dd); + GConvert(xx, yy, USERC, DEVICE, dd); + GConvert(xx+1, yy+1, USERC, DEVICE, dd); if (R_FINITE(xx[0]) && R_FINITE(yy[0]) && R_FINITE(xx[1]) && R_FINITE(yy[1])) { @@ -1886,8 +1886,8 @@ y0 = yb[i%nyb]; x1 = xr[i%nxr]; y1 = yt[i%nyt]; - GConvert(&x0, &y0, USER, DEVICE, dd); - GConvert(&x1, &y1, USER, DEVICE, dd); + GConvert(&x0, &y0, USERC, DEVICE, dd); + GConvert(&x1, &y1, USERC, DEVICE, dd); if (R_FINITE(x0) && R_FINITE(y0) && R_FINITE(x1) && R_FINITE(y1)) GRect(x0, y0, x1, y1, DEVICE, INTEGER(col)[i % ncol], INTEGER(border)[i % nborder], dd); @@ -1968,8 +1968,8 @@ yy0 = y0[i%ny0]; xx1 = x1[i%nx1]; yy1 = y1[i%ny1]; - GConvert(&xx0, &yy0, USER, DEVICE, dd); - GConvert(&xx1, &yy1, USER, DEVICE, dd); + GConvert(&xx0, &yy0, USERC, DEVICE, dd); + GConvert(&xx1, &yy1, USERC, DEVICE, dd); if (R_FINITE(xx0) && R_FINITE(yy0) && R_FINITE(xx1) && R_FINITE(yy1) && !R_TRANSPARENT(thiscol = INTEGER(col)[i % ncol])) { gpptr(dd)->col = thiscol; @@ -1997,7 +1997,7 @@ gpptr(dd)->lty = dpptr(dd)->lty; else gpptr(dd)->lty = lty; - GPolygon(n, x, y, USER, fill, border, dd); + GPolygon(n, x, y, USERC, fill, border, dd); } SEXP attribute_hidden do_polygon(SEXP call, SEXP op, SEXP args, SEXP env) @@ -2041,7 +2041,7 @@ for (i = 0; i < nx; i++) { xx = x[i]; yy = y[i]; - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); if ((R_FINITE(xx) && R_FINITE(yy)) && !(R_FINITE(xold) && R_FINITE(yold))) start = i; /* first point of current segment */ @@ -2182,7 +2182,7 @@ for (i = 0; i < imax2(n,ntxt); i++) { xx = x[i % n]; yy = y[i % n]; - GConvert(&xx, &yy, USER, INCHES, dd); + GConvert(&xx, &yy, USERC, INCHES, dd); if (R_FINITE(xx) && R_FINITE(yy)) { if (ncol && !isNAcol(rawcol, i, ncol)) gpptr(dd)->col = INTEGER(col)[i % ncol]; @@ -2621,7 +2621,7 @@ vpos = 0.5 * gpptr(dd)->mar[2]; adjy = 0.5; } - hpos = GConvertX(adj, NPC, USER, dd); + hpos = GConvertX(adj, NPC, USERC, dd); where = MAR3; } if (isExpression(Main)) { @@ -2659,7 +2659,7 @@ where = 1; } else { - hpos = GConvertX(adj, NPC, USER, dd); + hpos = GConvertX(adj, NPC, USERC, dd); where = 0; } if (isExpression(sub)) @@ -2695,7 +2695,7 @@ where = 1; } else { - hpos = GConvertX(adj, NPC, USER, dd); + hpos = GConvertX(adj, NPC, USERC, dd); where = 0; } if (isExpression(xlab)) @@ -2731,7 +2731,7 @@ where = 1; } else { - hpos = GConvertY(adj, NPC, USER, dd); + hpos = GConvertY(adj, NPC, USERC, dd); where = 0; } if (isExpression(ylab)) @@ -2878,7 +2878,7 @@ for(; yy[lstop] <= 0 && lstop > 0; lstop--); } - GPolyline(lstop-lstart+1, xx+lstart, yy+lstart, USER, dd); + GPolyline(lstop-lstart+1, xx+lstart, yy+lstart, USERC, dd); #undef NS } else { /* non-log plots, possibly with log scales */ @@ -2889,7 +2889,7 @@ y[1] = pow(10., y[1]); } - GLine(x[0], y[0], x[1], y[1], USER, dd); + GLine(x[0], y[0], x[1], y[1], USERC, dd); } } GMode(0, dd); @@ -2909,7 +2909,7 @@ getxlimits(x, dd); y[0] = aa; y[1] = aa; - GLine(x[0], y[0], x[1], y[1], USER, dd); + GLine(x[0], y[0], x[1], y[1], USERC, dd); } nlines++; } @@ -2929,7 +2929,7 @@ getylimits(y, dd); x[0] = aa; x[1] = aa; - GLine(x[0], y[0], x[1], y[1], USER, dd); + GLine(x[0], y[0], x[1], y[1], USERC, dd); } nlines++; } @@ -3017,7 +3017,7 @@ for (i = 0; i < n; i++) { xp = REAL(x)[i]; yp = REAL(y)[i]; - GConvert(&xp, &yp, USER, DEVICE, dd); + GConvert(&xp, &yp, USERC, DEVICE, dd); drawPointsLines(xp, yp, xold, yold, type, i==0, dd); xold = xp; yold = yp; @@ -3044,12 +3044,12 @@ GMode(2, dd); for (i = 0; i < n; i++) { - if (!GLocator(&(REAL(x)[i]), &(REAL(y)[i]), USER, dd)) break; + if (!GLocator(&(REAL(x)[i]), &(REAL(y)[i]), USERC, dd)) break; if (type != 'n') { GMode(1, dd); xp = REAL(x)[i]; yp = REAL(y)[i]; - GConvert(&xp, &yp, USER, DEVICE, dd); + GConvert(&xp, &yp, USERC, DEVICE, dd); drawPointsLines(xp, yp, xold, yold, type, i==0, dd); GMode(0, dd); GMode(2, dd); @@ -3145,7 +3145,7 @@ if (LOGICAL(draw)[0] && plot) { xi = REAL(x)[i]; yi = REAL(y)[i]; - GConvert(&xi, &yi, USER, INCHES, dd); + GConvert(&xi, &yi, USERC, INCHES, dd); posi = INTEGER(pos)[i]; drawLabel(xi, yi, posi, offset, CHAR(STRING_ELT(l, i % nl)), @@ -3223,7 +3223,7 @@ for (i = 0; i < n; i++) { xi = REAL(x)[i]; yi = REAL(y)[i]; - GConvert(&xi, &yi, USER, INCHES, dd); + GConvert(&xi, &yi, USERC, INCHES, dd); if (!R_FINITE(xi) || !R_FINITE(yi)) continue; d = hypot(xp-xi, yp-yi); if (d < dmin) { @@ -3255,12 +3255,12 @@ yi = yp; INTEGER(pos)[imin] = 0; /* now record where to replot if necessary */ - GConvert(&xp, &yp, INCHES, USER, dd); + GConvert(&xp, &yp, INCHES, USERC, dd); REAL(x)[imin] = xp; REAL(y)[imin] = yp; } else { xi = REAL(x)[imin]; yi = REAL(y)[imin]; - GConvert(&xi, &yi, USER, INCHES, dd); + GConvert(&xi, &yi, USERC, INCHES, dd); if (fabs(xp-xi) >= fabs(yp-yi)) { if (xp >= xi) INTEGER(pos)[imin] = 4; @@ -3403,7 +3403,7 @@ xl = dnd_xpos[-k-1]; yl = (dnd_hang >= 0) ? *y - dnd_hang : 0; if(STRING_ELT(dnd_llabels, -k-1) != NA_STRING) - GText(xl, yl-dnd_offset, USER, + GText(xl, yl-dnd_offset, USERC, CHAR(STRING_ELT(dnd_llabels, -k-1)), getCharCE(STRING_ELT(dnd_llabels, -k-1)), 1.0, 0.3, 90.0, dd); @@ -3415,7 +3415,7 @@ xr = dnd_xpos[-k-1]; yr = (dnd_hang >= 0) ? *y - dnd_hang : 0; if(STRING_ELT(dnd_llabels, -k-1) != NA_STRING) - GText(xr, yr-dnd_offset, USER, + GText(xr, yr-dnd_offset, USERC, CHAR(STRING_ELT(dnd_llabels, -k-1)), getCharCE(STRING_ELT(dnd_llabels, -k-1)), 1.0, 0.3, 90.0, dd); @@ -3424,7 +3424,7 @@ xx[1] = xl; yy[1] = *y; xx[2] = xr; yy[2] = *y; xx[3] = xr; yy[3] = yr; - GPolyline(4, xx, yy, USER, dd); + GPolyline(4, xx, yy, USERC, dd); *x = 0.5 * (xl + xr); } @@ -3487,7 +3487,7 @@ ProcessInlinePars(args, dd, call); gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cex; dnd_offset = GConvertYUnits(GStrWidth("m", CE_ANY, INCHES, dd), INCHES, - USER, dd); + USERC, dd); /* override par("xpd") and force clipping to figure region NOTE: don't override to _reduce_ clipping region */ @@ -3735,8 +3735,8 @@ if (inches > 0) rx *= inches / pmax; else - rx = GConvertXUnits(rx, USER, INCHES, dd); - GCircle(REAL(x)[i], REAL(y)[i], USER, rx, + rx = GConvertXUnits(rx, USERC, INCHES, dd); + GCircle(REAL(x)[i], REAL(y)[i], USERC, rx, INTEGER(bg)[i%nbg], INTEGER(fg)[i%nfg], dd); } } @@ -3752,13 +3752,13 @@ p0 = REAL(p)[i]; xx = REAL(x)[i]; yy = REAL(y)[i]; - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); if (inches > 0) { p0 *= inches / pmax; rx = GConvertXUnits(0.5 * p0, INCHES, DEVICE, dd); } else { - rx = GConvertXUnits(0.5 * p0, USER, DEVICE, dd); + rx = GConvertXUnits(0.5 * p0, USERC, DEVICE, dd); } GRect(xx - rx, yy - rx, xx + rx, yy + rx, DEVICE, INTEGER(bg)[i%nbg], INTEGER(fg)[i%nfg], dd); @@ -3775,7 +3775,7 @@ R_FINITE(REAL(p)[i]) && R_FINITE(REAL(p)[i+nr])) { xx = REAL(x)[i]; yy = REAL(y)[i]; - GConvert(&xx, &yy, USER, DEVICE, dd); + GConvert(&xx, &yy, USERC, DEVICE, dd); p0 = REAL(p)[i]; p1 = REAL(p)[i+nr]; if (inches > 0) { @@ -3785,8 +3785,8 @@ ry = GConvertYUnits(0.5 * p1, INCHES, DEVICE, dd); } else { - rx = GConvertXUnits(0.5 * p0, USER, DEVICE, dd); - ry = GConvertYUnits(0.5 * p1, USER, DEVICE, dd); + rx = GConvertXUnits(0.5 * p0, USERC, DEVICE, dd); + ry = GConvertYUnits(0.5 * p1, USERC, DEVICE, dd); } GRect(xx - rx, yy - ry, xx + rx, yy + ry, DEVICE, INTEGER(bg)[i%nbg], INTEGER(fg)[i%nfg], dd); @@ -3808,7 +3808,7 @@ xx = REAL(x)[i]; yy = REAL(y)[i]; if (R_FINITE(xx) && R_FINITE(yy)) { - GConvert(&xx, &yy, USER, NDC, dd); + GConvert(&xx, &yy, USERC, NDC, dd); if (inches > 0) { for(j = 0; j < nc; j++) { p0 = REAL(p)[i + j * nr]; @@ -3820,7 +3820,7 @@ for(j = 0; j < nc; j++) { p0 = REAL(p)[i + j * nr]; if (!R_FINITE(p0)) p0 = 0; - pp[j] = GConvertXUnits(p0, USER, INCHES, dd); + pp[j] = GConvertXUnits(p0, USERC, INCHES, dd); } } for(j = 0; j < nc; j++) { @@ -3859,7 +3859,7 @@ R_FINITE(p2) && R_FINITE(p3)) { if (p2 < 0) p2 = 0; else if (p2 > 1) p2 = 1; if (p3 < 0) p3 = 0; else if (p3 > 1) p3 = 1; - GConvert(&xx, &yy, USER, NDC, dd); + GConvert(&xx, &yy, USERC, NDC, dd); if (inches > 0) { p0 *= inches / pmax; p1 *= inches / pmax; @@ -3867,8 +3867,8 @@ ry = GConvertYUnits(0.5 * p1, INCHES, NDC, dd); } else { - rx = GConvertXUnits(0.5 * p0, USER, NDC, dd); - ry = GConvertYUnits(0.5 * p1, USER, NDC, dd); + rx = GConvertXUnits(0.5 * p0, USERC, NDC, dd); + ry = GConvertYUnits(0.5 * p1, USERC, NDC, dd); } GRect(xx - rx, yy - ry, xx + rx, yy + ry, NDC, INTEGER(bg)[i%nbg], INTEGER(fg)[i%nfg], dd); @@ -3908,7 +3908,7 @@ p4 = REAL(p)[i + 4 * nr];/* median proport. in [0,1] */ if (R_FINITE(p0) && R_FINITE(p1) && R_FINITE(p2) && R_FINITE(p3) && R_FINITE(p4)) { - GConvert(&xx, &yy, USER, NDC, dd); + GConvert(&xx, &yy, USERC, NDC, dd); if (inches > 0) { p0 *= inches / pmax; p1 *= inches / pmax; @@ -3920,10 +3920,10 @@ p3 = GConvertYUnits(p3, INCHES, NDC, dd); } else { - p0 = GConvertXUnits(p0, USER, NDC, dd); - p1 = GConvertYUnits(p1, USER, NDC, dd); - p2 = GConvertYUnits(p2, USER, NDC, dd); - p3 = GConvertYUnits(p3, USER, NDC, dd); + p0 = GConvertXUnits(p0, USERC, NDC, dd); + p1 = GConvertYUnits(p1, USERC, NDC, dd); + p2 = GConvertYUnits(p2, USERC, NDC, dd); + p3 = GConvertYUnits(p3, USERC, NDC, dd); } rx = 0.5 * p0; ry = 0.5 * p1; @@ -4012,7 +4012,7 @@ for (i = 0; i < nx; i++) { xx[i] = x[i]; yy[i] = y[i]; - GConvert(&(xx[i]), &(yy[i]), USER, DEVICE, dd); + GConvert(&(xx[i]), &(yy[i]), USERC, DEVICE, dd); } GClip(dd); gc.col = INTEGER(border)[0]; @@ -4039,7 +4039,7 @@ for (i = 0; i < nx; i++) { xx[i] = x0[i]; yy[i] = y0[i]; - GConvert(&(xx[i]), &(yy[i]), DEVICE, USER, dd); + GConvert(&(xx[i]), &(yy[i]), DEVICE, USERC, dd); } SET_VECTOR_ELT(ans, 0, tmpx); SET_VECTOR_ELT(ans, 1, tmpy); @@ -4075,8 +4075,8 @@ y2 = asReal(CAR(args)); if(!R_FINITE(y2)) error("invalid '%s' argument", "y2"); - GConvert(&x1, &y1, USER, DEVICE, dd); - GConvert(&x2, &y2, USER, DEVICE, dd); + GConvert(&x1, &y1, USERC, DEVICE, dd); + GConvert(&x2, &y2, USERC, DEVICE, dd); GESetClip(x1, y1, x2, y2, dd); /* avoid GClip resetting this */ gpptr(dd)->oldxpd = gpptr(dd)->xpd; --- R-2.10.1/src/main/plot3d.c.orig Fri Mar 20 00:05:29 2009 +++ R-2.10.1/src/main/plot3d.c Sun Dec 27 22:10:57 2009 @@ -173,10 +173,10 @@ double x0, double y0, double x1, double y1, pGEDevDesc dd) { double delta = height / width; - double dx = GConvertXUnits(x1 - x0, USER, INCHES, dd) * delta; - double dy = GConvertYUnits(y1 - y0, USER, INCHES, dd) * delta; - dx = GConvertYUnits(dx, INCHES, USER, dd); - dy = GConvertXUnits(dy, INCHES, USER, dd); + double dx = GConvertXUnits(x1 - x0, USERC, INCHES, dd) * delta; + double dy = GConvertYUnits(y1 - y0, USERC, INCHES, dd) * delta; + dx = GConvertYUnits(dx, INCHES, USERC, dd); + dy = GConvertXUnits(dy, INCHES, USERC, dd); REAL(label)[0] = x0 + dy; REAL(label)[4] = y0 - dx; @@ -245,9 +245,9 @@ while (i < 4) { x = REAL(label)[i]; y = REAL(label)[i+4]; - GConvert(&x, &y, USER, NDC, dd); - /* x = GConvertXUnits(REAL(label)[i], USER, NDC, dd); - y = GConvertYUnits(REAL(label)[i+4], USER, NDC, dd); */ + GConvert(&x, &y, USERC, NDC, dd); + /* x = GConvertXUnits(REAL(label)[i], USERC, NDC, dd); + y = GConvertYUnits(REAL(label)[i+4], USERC, NDC, dd); */ if ((x < 0) || (x > 1) || (y < 0) || (y > 1)) @@ -424,8 +424,8 @@ */ dX = xxx[jjj] - xxx[jjj - n - 1]; /* jjj - n - 1 == 0 */ dY = yyy[jjj] - yyy[jjj - n - 1]; - dXC = GConvertXUnits(dX, USER, INCHES, dd); - dYC = GConvertYUnits(dY, USER, INCHES, dd); + dXC = GConvertXUnits(dX, USERC, INCHES, dd); + dYC = GConvertYUnits(dY, USERC, INCHES, dd); distanceSum = hypot(dXC, dYC); jjj++; n++; @@ -450,8 +450,8 @@ */ dX = xxx[jjj] - xxx[jjj + n + 1]; /*jjj + n + 1 == ns -1 */ dY = yyy[jjj] - yyy[jjj + n + 1]; - dXC = GConvertXUnits(dX, USER, INCHES, dd); - dYC = GConvertYUnits(dY, USER, INCHES, dd); + dXC = GConvertXUnits(dX, USERC, INCHES, dd); + dYC = GConvertYUnits(dY, USERC, INCHES, dd); distanceSum = hypot(dXC, dYC); jjj--; n++; @@ -1138,8 +1138,8 @@ */ dX = xxx[jjj] - xxx[jjj - n - 1]; dY = yyy[jjj] - yyy[jjj - n - 1]; - dXC = GConvertXUnits(dX, USER, INCHES, dd); - dYC = GConvertYUnits(dY, USER, INCHES, dd); + dXC = GConvertXUnits(dX, USERC, INCHES, dd); + dYC = GConvertYUnits(dY, USERC, INCHES, dd); distanceSum = hypot(dXC, dYC); /* Calculate the variance of the gradients @@ -1148,8 +1148,8 @@ */ deltaX = xxx[jjj] - xxx[jjj - 1]; deltaY = yyy[jjj] - yyy[jjj - 1]; - deltaXC = GConvertXUnits(deltaX, USER, INCHES, dd); - deltaYC = GConvertYUnits(deltaY, USER, INCHES, dd); + deltaXC = GConvertXUnits(deltaX, USERC, INCHES, dd); + deltaYC = GConvertYUnits(deltaY, USERC, INCHES, dd); if (deltaX == 0) {deltaX = 1;} avgGradient += (deltaY/deltaX); squareSum += avgGradient * avgGradient; @@ -1189,8 +1189,8 @@ } /* switch (method) */ if (method == 0) { - GPolyline(ns, xxx, yyy, USER, dd); - GText(xxx[indx], yyy[indx], USER, buffer, + GPolyline(ns, xxx, yyy, USERC, dd); + GText(xxx[indx], yyy[indx], USERC, buffer, CE_NATIVE/*FIX*/, .5, .5, 0, dd); } @@ -1197,10 +1197,10 @@ else { for (iii = 0; iii < indx; iii++) GLine(xxx[iii], yyy[iii], - xxx[iii+1], yyy[iii+1], USER, dd); + xxx[iii+1], yyy[iii+1], USERC, dd); for (iii = indx+range; iii < ns - 1; iii++) GLine(xxx[iii], yyy[iii], - xxx[iii+1], yyy[iii+1], USER, dd); + xxx[iii+1], yyy[iii+1], USERC, dd); if (gotLabel) { /* find which plot edge we are closest to */ @@ -1230,9 +1230,9 @@ closest = 1; dx = GConvertXUnits(xxx[indx+range] - xxx[indx], - USER, INCHES, dd); + USERC, INCHES, dd); dy = GConvertYUnits(yyy[indx+range] - yyy[indx], - USER, INCHES, dd); + USERC, INCHES, dd); dxy = hypot(dx, dy); /* save the current label for checking overlap */ @@ -1257,7 +1257,7 @@ if (labelDistance / dxy < 1) GLine(xxx[indx], yyy[indx], xStart, yStart, - USER, dd); + USERC, dd); } else { xStart = xxx[indx] + (xxx[indx+range] - xxx[indx]) * @@ -1268,7 +1268,7 @@ if (labelDistance / dxy < 1) GLine(xStart, yStart, xxx[indx+range], yyy[indx+range], - USER, dd); + USERC, dd); } /*** Draw contour labels ***/ @@ -1303,8 +1303,8 @@ /* convert to INCHES for calculation of angle to draw text */ - GConvert(&ux, &uy, USER, INCHES, dd); - GConvert(&vx, &vy, USER, INCHES, dd); + GConvert(&ux, &uy, USERC, INCHES, dd); + GConvert(&vx, &vy, USERC, INCHES, dd); /* 0, .5 => left, centre justified */ GText (ux, uy, INCHES, buffer, CE_NATIVE/*FIX*/,0, .5, @@ -1317,7 +1317,7 @@ } /* if (drawLabels) */ else { - GPolyline(ns, xxx, yyy, USER, dd); + GPolyline(ns, xxx, yyy, USERC, dd); } GMode(0, dd); @@ -1732,7 +1732,7 @@ z[i + j * nx], px, py, pz, &npt); if (npt > 2) - GPolygon(npt, px, py, USER, col[(k-1)%ncol], + GPolygon(npt, px, py, USERC, col[(k-1)%ncol], R_TRANWHITE, dd); } } @@ -1809,7 +1809,7 @@ for (j = 0; j < ny - 1; j++) { tmp = z[i + j * (nx - 1)]; if (tmp >= 0 && tmp < nc && tmp != NA_INTEGER) - GRect(x[i], y[j], x[i+1], y[j+1], USER, c[tmp], + GRect(x[i], y[j], x[i+1], y[j+1], USERC, c[tmp], R_TRANWHITE, dd); } } @@ -1970,7 +1970,7 @@ b = shade * R_BLUE(newcol); newcol = R_RGB(r, g, b); } - GPolygon(nv, xx, yy, USER, newcol, border, dd); + GPolygon(nv, xx, yy, USERC, newcol, border, dd); } } } @@ -2119,16 +2119,16 @@ if ((front && nearby) || (!front && !nearby)) { if (!EdgeDone[Edge[f][0]]++) GLine(v0[0]/v0[3], v0[1]/v0[3], - v1[0]/v1[3], v1[1]/v1[3], USER, dd); + v1[0]/v1[3], v1[1]/v1[3], USERC, dd); if (!EdgeDone[Edge[f][1]]++) GLine(v1[0]/v1[3], v1[1]/v1[3], - v2[0]/v2[3], v2[1]/v2[3], USER, dd); + v2[0]/v2[3], v2[1]/v2[3], USERC, dd); if (!EdgeDone[Edge[f][2]]++) GLine(v2[0]/v2[3], v2[1]/v2[3], - v3[0]/v3[3], v3[1]/v3[3], USER, dd); + v3[0]/v3[3], v3[1]/v3[3], USERC, dd); if (!EdgeDone[Edge[f][3]]++) GLine(v3[0]/v3[3], v3[1]/v3[3], - v0[0]/v0[3], v0[1]/v0[3], USER, dd); + v0[0]/v0[3], v0[1]/v0[3], USERC, dd); } } gpptr(dd)->lty = ltysave; @@ -2286,7 +2286,7 @@ /* change in 2.5.0 to use cex.lab and font.lab */ gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cexlab; gpptr(dd)->font = gpptr(dd)->fontlab; - GText(v3[0]/v3[3], v3[1]/v3[3], USER, label, enc, .5, .5, + GText(v3[0]/v3[3], v3[1]/v3[3], USERC, label, enc, .5, .5, labelAngle(v1[0]/v1[3], v1[1]/v1[3], v2[0]/v2[3], v2[1]/v2[3]), dd); /* Draw axis ticks */ @@ -2299,7 +2299,7 @@ /* arrow head is 0.25 inches long, with angle 30 degrees, and drawn at v2 end of line */ GArrow(v1[0]/v1[3], v1[1]/v1[3], - v2[0]/v2[3], v2[1]/v2[3], USER, + v2[0]/v2[3], v2[1]/v2[3], USERC, 0.1, 10, 2, dd); break; case 2: /* "detailed": normal ticks as per 2D plots */ @@ -2337,9 +2337,9 @@ TransVector(u3, VT, v3); /* Draw tick line */ GLine(v1[0]/v1[3], v1[1]/v1[3], - v2[0]/v2[3], v2[1]/v2[3], USER, dd); + v2[0]/v2[3], v2[1]/v2[3], USERC, dd); /* Draw tick label */ - GText(v3[0]/v3[3], v3[1]/v3[3], USER, + GText(v3[0]/v3[3], v3[1]/v3[3], USERC, CHAR(STRING_ELT(lab, i)), getCharCE(STRING_ELT(lab, i)), .5, .5, 0, dd); --- R-2.10.1/src/library/stats/src/port.c.orig Wed Jun 11 16:52:38 2008 +++ R-2.10.1/src/library/stats/src/port.c Mon Dec 28 19:47:00 2009 @@ -72,7 +72,7 @@ double F77_NAME(dd7tpr)(int *p, const double x[], const double y[]) { int ione = 1; - return F77_CALL(ddot)(p, x, &ione, y, &ione); + return SPL_CALL(ddot)(*p, x, ione, y, ione); } /* ditsum... prints iteration summary, initial and final alf. */ @@ -222,7 +222,7 @@ double F77_NAME(dv2nrm)(int *n, const double x[]) { int ione = 1; - return F77_CALL(dnrm2)(n, x, &ione); + return SPL_CALL(dnrm2)(*n, x, ione); } /* dv7cpy.... copy src to dest */ @@ -274,7 +274,7 @@ void F77_NAME(dv7swp)(int *n, double x[], double y[]) { int ione = 1; - F77_CALL(dswap)(n, x, &ione, y, &ione); + SPL_CALL(dswap)(*n, x, ione, y, ione); } /* i7copy... copies one integer vector to another. */ --- R-2.10.1/src/main/print.c.orig Mon Sep 28 00:05:39 2009 +++ R-2.10.1/src/main/print.c Sun Dec 27 22:34:24 2009 @@ -1054,14 +1054,3 @@ } return(0); } - -/* Fortran-callable error routine for lapack */ - -void F77_NAME(xerbla)(const char *srname, int *info) -{ - /* srname is not null-terminated. It should be 6 characters. */ - char buf[7]; - strncpy(buf, srname, 6); - buf[6] = '\0'; - error(_("BLAS/LAPACK routine '%6s' gave error code %d"), buf, -(*info)); -} --- R-2.10.1/src/appl/uncmin.c.orig Wed Sep 5 00:13:32 2007 +++ R-2.10.1/src/appl/uncmin.c Mon Dec 28 20:40:27 2009 @@ -173,7 +173,7 @@ int i, length, one = 1; for (i = 0, length = n; i < n; --length, ++i) - y[i] = F77_CALL(ddot)(&length, &a[i + i * nr], &one, &x[i], &one); + y[i] = SPL_CALL(ddot)(length, &a[i + i * nr], one, &x[i], one); } /* mvmltu */ @@ -507,7 +507,7 @@ (*fcn)(n, xpls, fpls, state); dltf = *fpls - f; - slp = F77_CALL(ddot)(&n, g, &one, sc, &one); + slp = SPL_CALL(ddot)(n, g, one, sc, one); /* next statement added for case of compilers which do not optimize evaluation of next "if" statement (in which case fplsp could be @@ -658,10 +658,10 @@ if (sln > stepmx) { /* newton step longer than maximum allowed */ scl = stepmx / sln; - F77_CALL(dscal)(&n, &scl, p, &one); + SPL_CALL(dscal)(n, scl, p, one); sln = stepmx; } - slp = F77_CALL(ddot)(&n, g, &one, p, &one); + slp = SPL_CALL(ddot)(n, g, one, p, one); rln = 0.; for (i = 0; i < n; ++i) { temp1 = fabs(p[i])/ fmax2(fabs(x[i]), 1./sx[i]); @@ -805,7 +805,7 @@ ssd[i] = -(alpha / bet) * g[i] / sx[i]; *cln = alpha * sqrt(alpha) / bet; *eta = (.8 * alpha * alpha / - (-bet * F77_CALL(ddot)(&n, g, &one, p, &one))) + .2; + (-bet * SPL_CALL(ddot)(n, g, one, p, one))) + .2; for (i = 0; i < n; ++i) v[i] = *eta * sx[i] * p[i] - ssd[i]; if (*dlt == -1.) *dlt = fmin2(*cln, stepmx); @@ -824,8 +824,8 @@ else { /* calculate convex combination of ssd and eta*p which has scaled length dlt */ - dot1 = F77_CALL(ddot)(&n, v, &one, ssd, &one); - dot2 = F77_CALL(ddot)(&n, v, &one, v, &one); + dot1 = SPL_CALL(ddot)(n, v, one, ssd, one); + dot2 = SPL_CALL(ddot)(n, v, one, v, one); alam = (-dot1 + sqrt(dot1 * dot1 - dot2 * (*cln * *cln - *dlt * *dlt))) / dot2; for (i = 0; i < n; ++i) @@ -966,7 +966,7 @@ /* solve l*y = (sx**2)*p */ F77_CALL(dtrsl)(a, &nr, &n, wrk0, &job, &info); /* Computing 2nd power */ - temp1 = F77_CALL(dnrm2)(&n, wrk0, &one); + temp1 = SPL_CALL(dnrm2)(n, wrk0, one); *phip0 = -(temp1 * temp1) / rnwtln; *fstime = FALSE; } @@ -1012,7 +1012,7 @@ for (i = 0; i < n; ++i) wrk0[i] = sx[i] * sx[i] * sc[i]; F77_CALL(dtrsl)(a, &nr, &n, wrk0, &job, &info); - temp1 = F77_CALL(dnrm2)(&n, wrk0, &one); + temp1 = SPL_CALL(dnrm2)(n, wrk0, one); phip = -(temp1 * temp1) / stepln; if ((alo * *dlt <= stepln && stepln <= hi * *dlt) || (amuup - amulo > 0.)) { @@ -1182,13 +1182,13 @@ s[i] = xpls[i] - x[i]; y[i] = gpls[i] - g[i]; } - den1 = F77_CALL(ddot)(&n, s, &one, y, &one); - snorm2 = F77_CALL(dnrm2)(&n, s, &one); - ynrm2 = F77_CALL(dnrm2)(&n, y, &one); + den1 = SPL_CALL(ddot)(n, s, one, y, one); + snorm2 = SPL_CALL(dnrm2)(n, s, one); + ynrm2 = SPL_CALL(dnrm2)(n, y, one); if (den1 < sqrt(epsm) * snorm2 * ynrm2) return; mvmlts(nr, n, a, s, t); - den2 = F77_CALL(ddot)(&n, s, &one, t, &one); + den2 = SPL_CALL(ddot)(n, s, one, t, one); if (*noupdt) { /* h <-- [(s+)y/(s+)hs]h */ @@ -1266,15 +1266,15 @@ s[i] = xpls[i] - x[i]; y[i] = gpls[i] - g[i]; } - den1 = F77_CALL(ddot)(&n, s, &one, y, &one); - snorm2 = F77_CALL(dnrm2)(&n, s, &one); - ynrm2 = F77_CALL(dnrm2)(&n, y, &one); + den1 = SPL_CALL(ddot)(n, s, one, y, one); + snorm2 = SPL_CALL(dnrm2)(n, s, one); + ynrm2 = SPL_CALL(dnrm2)(n, y, one); if (den1 < sqrt(epsm) * snorm2 * ynrm2) return; mvmltu(nr, n, a, s, u); - den2 = F77_CALL(ddot)(&n, u, &one, u, &one); + den2 = SPL_CALL(ddot)(n, u, one, u, one); /* l <-- sqrt(den1/den2)*l */ --- R-2.10.1/src/include/R_ext/Lapack.h.orig Tue Mar 25 13:26:20 2008 +++ R-2.10.1/src/include/R_ext/Lapack.h Tue Dec 29 05:39:57 2009 @@ -26,6 +26,7 @@ #include /* for F77_... */ #include /* for Rcomplex */ #include +#include /* LAPACK function names are [zds](), where d denotes the real @@ -46,123 +47,14 @@ /* matrix norms: converting typstr[] to one of {'M', 'O', 'I', 'F'} * or signal error(): */ -La_extern char La_norm_type(const char *typstr); +La_extern char La_norm_type(const char typstr); /* matrix (reciprocal) condition numbers: convert typstr[] to 'O'(ne) or 'I'(nf) * or signal error(): */ -La_extern char La_rcond_type(const char *typstr); +La_extern char La_rcond_type(const char typstr); +/** not defined in sunperf.h but included */ - -/* Selected Double Precision Lapack Routines - ======== - */ - -/* Double precision BiDiagonal matrices */ - -/* DBDSQR - compute the singular value decomposition (SVD) of a real */ -/* N-by-N (upper or lower) bidiagonal matrix B */ -La_extern void -F77_NAME(dbdsqr)(const char* uplo, const int* n, const int* ncvt, - const int* nru, const int* ncc, double* d, double* e, - double* vt, const int* ldvt, double* u, const int* ldu, - double* c, const int* ldc, double* work, int* info); -/* DDISNA - compute the reciprocal condition numbers for the */ -/* eigenvectors of a real symmetric or complex Hermitian matrix or */ -/* for the left or right singular vectors of a general m-by-n */ -/* matrix */ -La_extern void -F77_NAME(ddisna)(const char* job, const int* m, const int* n, - double* d, double* sep, int* info); - -/* Double precision General Banded matrices */ - -/* DGBBRD - reduce a real general m-by-n band matrix A to upper */ -/* bidiagonal form B by an orthogonal transformation */ -La_extern void -F77_NAME(dgbbrd)(const char* vect, const int* m, const int* n, - const int* ncc, const int* kl, const int* ku, - double* ab, const int* ldab, - double* d, double* e, double* q, - const int* ldq, double* pt, const int* ldpt, - double* c, const int* ldc, - double* work, int* info); -/* DGBCON - estimate the reciprocal of the condition number of a */ -/* real general band matrix A, in either the 1-norm or the */ -/* infinity-norm */ -La_extern void -F77_NAME(dgbcon)(const char* norm, const int* n, const int* kl, - const int* ku, double* ab, const int* ldab, - int* ipiv, const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DGBEQU - compute row and column scalings intended to equilibrate */ -/* an M-by-N band matrix A and reduce its condition number */ -La_extern void -F77_NAME(dgbequ)(const int* m, const int* n, const int* kl, const int* ku, - double* ab, const int* ldab, double* r, double* c, - double* rowcnd, double* colcnd, double* amax, int* info); -/* DGBRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is banded, and provides */ -/* error bounds and backward error estimates for the solution */ -La_extern void -F77_NAME(dgbrfs)(const char* trans, const int* n, const int* kl, - const int* ku, const int* nrhs, double* ab, - const int* ldab, double* afb, const int* ldafb, - int* ipiv, double* b, const int* ldb, - double* x, const int* ldx, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGBSV - compute the solution to a real system of linear */ -/* equations A * X = B, where A is a band matrix of order N with */ -/* KL subdiagonals and KU superdiagonals, and X and B are */ -/* N-by-NRHS matrices */ -La_extern void -F77_NAME(dgbsv)(const int* n, const int* kl,const int* ku, - const int* nrhs, double* ab, const int* ldab, - int* ipiv, double* b, const int* ldb, int* info); -/* DGBSVX - use the LU factorization to compute the solution to a */ -/* real system of linear equations A * X = B or A**T * X = B */ -La_extern void -F77_NAME(dgbsvx)(const int* fact, const char* trans, - const int* n, const int* kl,const int* ku, - const int* nrhs, double* ab, const int* ldab, - double* afb, const int* ldafb, int* ipiv, - const char* equed, double* r, double* c, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGBTF2 - compute an LU factorization of a real m-by-n band */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgbtf2)(const int* m, const int* n, const int* kl,const int* ku, - double* ab, const int* ldab, int* ipiv, int* info); -/* DGBTRF - compute an LU factorization of a real m-by-n band */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgbtrf)(const int* m, const int* n, const int* kl,const int* ku, - double* ab, const int* ldab, int* ipiv, int* info); -/* DGBTRS - solve a system of linear equations A * X = B or */ -/* A' * X = B with a general band matrix A using the LU */ -/* factorization computed by DGBTRF */ -La_extern void -F77_NAME(dgbtrs)(const char* trans, const int* n, - const int* kl, const int* ku, const int* nrhs, - const double* ab, const int* ldab, const int* ipiv, - double* b, const int* ldb, int* info); - -/* Double precision GEneral matrices */ - -/* DGEBAK - form the right or left eigenvectors of a real general */ -/* matrix by backward transformation on the computed eigenvectors */ -/* of the balanced matrix output by DGEBAL */ -La_extern void -F77_NAME(dgebak)(const char* job, const char* side, const int* n, - const int* ilo, const int* ihi, double* scale, - const int* m, double* v, const int* ldv, int* info); -/* DGEBAL - balance a general real matrix A */ -La_extern void -F77_NAME(dgebal)(const char* job, const int* n, double* a, const int* lda, - int* ilo, int* ihi, double* scale, int* info); /* DGEBD2 - reduce a real general m by n matrix A to upper or */ /* lower bidiagonal form B by an orthogonal transformation */ La_extern void @@ -169,76 +61,6 @@ F77_NAME(dgebd2)(const int* m, const int* n, double* a, const int* lda, double* d, double* e, double* tauq, double* taup, double* work, int* info); -/* DGEBRD - reduce a general real M-by-N matrix A to upper or */ -/* lower bidiagonal form B by an orthogonal transformation */ -La_extern void -F77_NAME(dgebrd)(const int* m, const int* n, double* a, const int* lda, - double* d, double* e, double* tauq, double* taup, - double* work, const int* lwork, int* info); -/* DGECON - estimate the reciprocal of the condition number of a */ -/* general real matrix A, in either the 1-norm or the */ -/* infinity-norm, using the LU factorization computed by DGETRF */ -La_extern void -F77_NAME(dgecon)(const char* norm, const int* n, - const double* a, const int* lda, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DGEEQU - compute row and column scalings intended to equilibrate */ -/* an M-by-N matrix A and reduce its condition number */ -La_extern void -F77_NAME(dgeequ)(const int* m, const int* n, double* a, const int* lda, - double* r, double* c, double* rowcnd, double* colcnd, - double* amax, int* info); -/* DGEES - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues, the real Schur form T, and, optionally, the matrix */ -/* of Schur vectors Z */ -La_extern void -F77_NAME(dgees)(const char* jobvs, const char* sort, - int (*select)(const double*, const double*), - const int* n, double* a, const int* lda, - int* sdim, double* wr, double* wi, - double* vs, const int* ldvs, - double* work, const int* lwork, int* bwork, int* info); -/* DGEESX - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues, the real Schur form T, and, optionally, the matrix */ -/* of Schur vectors Z */ -La_extern void -F77_NAME(dgeesx)(const char* jobvs, const char* sort, - int (*select)(const double*, const double*), - const char* sense, const int* n, double* a, - const int* lda, int* sdim, double* wr, double* wi, - double* vs, const int* ldvs, double* rconde, - double* rcondv, double* work, const int* lwork, - int* iwork, const int* liwork, int* bwork, int* info); -/* DGEEV - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues and, optionally, the left and/or right eigenvectors */ -La_extern void -F77_NAME(dgeev)(const char* jobvl, const char* jobvr, - const int* n, double* a, const int* lda, - double* wr, double* wi, double* vl, const int* ldvl, - double* vr, const int* ldvr, - double* work, const int* lwork, int* info); -/* DGEEVX - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues and, optionally, the left and/or right eigenvectors */ -La_extern void -F77_NAME(dgeevx)(const char* balanc, const char* jobvl, const char* jobvr, - const char* sense, const int* n, double* a, const int* lda, - double* wr, double* wi, double* vl, const int* ldvl, - double* vr, const int* ldvr, int* ilo, int* ihi, - double* scale, double* abnrm, double* rconde, double* rcondv, - double* work, const int* lwork, int* iwork, int* info); -/* DGEGV - compute for a pair of n-by-n real nonsymmetric */ -/* matrices A and B, the generalized eigenvalues (alphar +/- */ -/* alphai*i, beta);, and optionally, the left and/or right */ -/* generalized eigenvectors (VL and VR); */ -La_extern void -F77_NAME(dgegv)(const char* jobvl, const char* jobvr, - const int* n, double* a, const int* lda, - double* b, const int* ldb, - double* alphar, double* alphai, - const double* beta, double* vl, const int* ldvl, - double* vr, const int* ldvr, - double* work, const int* lwork, int* info); /* DGEHD2 - reduce a real general matrix A to upper Hessenberg */ /* form H by an orthogonal similarity transformation */ La_extern void @@ -245,1382 +67,28 @@ F77_NAME(dgehd2)(const int* n, const int* ilo, const int* ihi, double* a, const int* lda, double* tau, double* work, int* info); -/* DGEHRD - reduce a real general matrix A to upper Hessenberg */ -/* form H by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dgehrd)(const int* n, const int* ilo, const int* ihi, - double* a, const int* lda, double* tau, - double* work, const int* lwork, int* info); /* DGELQ2 - compute an LQ factorization of a real m by n matrix A */ La_extern void F77_NAME(dgelq2)(const int* m, const int* n, double* a, const int* lda, double* tau, double* work, int* info); -/* DGELQF - compute an LQ factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgelqf)(const int* m, const int* n, - double* a, const int* lda, double* tau, - double* work, const int* lwork, int* info); -/* DGELS - solve overdetermined or underdetermined real linear */ -/* systems involving an M-by-N matrix A, or its transpose, using a */ -/* QR or LQ factorization of A */ -La_extern void -F77_NAME(dgels)(const char* trans, const int* m, const int* n, - const int* nrhs, double* a, const int* lda, - double* b, const int* ldb, - double* work, const int* lwork, int* info); -/* DGELSS - compute the minimum norm solution to a real linear */ -/* least squares problem */ -La_extern void -F77_NAME(dgelss)(const int* m, const int* n, const int* nrhs, - double* a, const int* lda, double* b, const int* ldb, - double* s, double* rcond, int* rank, - double* work, const int* lwork, int* info); -/* DGELSY - compute the minimum-norm solution to a real linear */ -/* least squares problem */ -La_extern void -F77_NAME(dgelsy)(const int* m, const int* n, const int* nrhs, - double* a, const int* lda, double* b, const int* ldb, - int* jpvt, const double* rcond, int* rank, - double* work, const int* lwork, int* info); /* DGEQL2 - compute a QL factorization of a real m by n matrix A */ La_extern void F77_NAME(dgeql2)(const int* m, const int* n, double* a, const int* lda, double* tau, double* work, int* info); -/* DGEQLF - compute a QL factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgeqlf)(const int* m, const int* n, - double* a, const int* lda, double* tau, - double* work, const int* lwork, int* info); -/* DGEQP3 - compute a QR factorization with column pivoting of a */ -/* real M-by-N matrix A using level 3 BLAS */ -La_extern void -F77_NAME(dgeqp3)(const int* m, const int* n, double* a, const int* lda, - int* jpvt, double* tau, double* work, const int* lwork, - int* info); -/* DGEQPF - compute a QR factorization with column pivoting of a */ -/* real M-by-N matrix A */ -La_extern void -F77_NAME(dgeqpf)(const int* m, const int* n, double* a, const int* lda, - int* jpvt, double* tau, double* work, int* info); /* DGEQR2 - compute a QR factorization of a real m by n matrix A */ La_extern void F77_NAME(dgeqr2)(const int* m, const int* n, double* a, const int* lda, double* tau, double* work, int* info); -/* DGEQRF - compute a QR factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgeqrf)(const int* m, const int* n, double* a, const int* lda, - double* tau, double* work, const int* lwork, int* info); -/* DGERFS - improve the computed solution to a system of linear */ -/* equations and provides error bounds and backward error */ -/* estimates for the solution */ -La_extern void -F77_NAME(dgerfs)(const char* trans, const int* n, const int* nrhs, - double* a, const int* lda, double* af, const int* ldaf, - int* ipiv, double* b, const int* ldb, - double* x, const int* ldx, double* ferr, double* berr, - double* work, int* iwork, int* info); /* DGERQ2 - compute an RQ factorization of a real m by n matrix A */ La_extern void F77_NAME(dgerq2)(const int* m, const int* n, double* a, const int* lda, double* tau, double* work, int* info); -/* DGERQF - compute an RQ factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgerqf)(const int* m, const int* n, double* a, const int* lda, - double* tau, double* work, const int* lwork, int* info); -/* DGESV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dgesv)(const int* n, const int* nrhs, double* a, const int* lda, - int* ipiv, double* b, const int* ldb, int* info); -/* DGESVD - compute the singular value decomposition (SVD); of a */ -/* real M-by-N matrix A, optionally computing the left and/or */ -/* right singular vectors */ -La_extern void -F77_NAME(dgesvd)(const char* jobu, const char* jobvt, const int* m, - const int* n, double* a, const int* lda, double* s, - double* u, const int* ldu, double* vt, const int* ldvt, - double* work, const int* lwork, int* info); -/* DGESVX - use the LU factorization to compute the solution to a */ -/* real system of linear equations A * X = B, */ -La_extern void -F77_NAME(dgesvx)(const int* fact, const char* trans, const int* n, - const int* nrhs, double* a, const int* lda, - double* af, const int* ldaf, int* ipiv, - char *equed, double* r, double* c, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGETF2 - compute an LU factorization of a general m-by-n */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgetf2)(const int* m, const int* n, double* a, const int* lda, - int* ipiv, int* info); -/* DGETRF - compute an LU factorization of a general M-by-N */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgetrf)(const int* m, const int* n, double* a, const int* lda, - int* ipiv, int* info); -/* DGETRI - compute the inverse of a matrix using the LU */ -/* factorization computed by DGETRF */ -La_extern void -F77_NAME(dgetri)(const int* n, double* a, const int* lda, - int* ipiv, double* work, const int* lwork, int* info); -/* DGETRS - solve a system of linear equations A * X = B or A' * */ -/* X = B with a general N-by-N matrix A using the LU factorization */ -/* computed by DGETRF */ -La_extern void -F77_NAME(dgetrs)(const char* trans, const int* n, const int* nrhs, - const double* a, const int* lda, const int* ipiv, - double* b, const int* ldb, int* info); - -/* Double precision General matrices Generalized problems */ - -/* DGGBAK - form the right or left eigenvectors of a real */ -/* generalized eigenvalue problem A*x = lambda*B*x, by backward */ -/* transformation on the computed eigenvectors of the balanced */ -/* pair of matrices output by DGGBAL */ -La_extern void -F77_NAME(dggbak)(const char* job, const char* side, - const int* n, const int* ilo, const int* ihi, - double* lscale, double* rscale, const int* m, - double* v, const int* ldv, int* info); -/* DGGBAL - balance a pair of general real matrices (A,B); */ -La_extern void -F77_NAME(dggbal)(const char* job, const int* n, double* a, const int* lda, - double* b, const int* ldb, int* ilo, int* ihi, - double* lscale, double* rscale, double* work, int* info); -/* DGGES - compute for a pair of N-by-N real nonsymmetric */ -/* matrices A, B the generalized eigenvalues, the generalized */ -/* real Schur form (S,T), optionally, the left and/or right matrices */ -/* of Schur vectors (VSL and VSR)*/ -La_extern void -F77_NAME(dgges)(const char* jobvsl, const char* jobvsr, const char* sort, - int (*delztg)(double*, double*, double*), - const int* n, double* a, const int* lda, - double* b, const int* ldb, double* alphar, - double* alphai, const double* beta, - double* vsl, const int* ldvsl, - double* vsr, const int* ldvsr, - double* work, const int* lwork, int* bwork, int* info); - -/* DGGGLM - solve a general Gauss-Markov linear model (GLM) problem */ -La_extern void -F77_NAME(dggglm)(const int* n, const int* m, const int* p, - double* a, const int* lda, double* b, const int* ldb, - double* d, double* x, double* y, - double* work, const int* lwork, int* info); -/* DGGHRD - reduce a pair of real matrices (A,B); to generalized */ -/* upper Hessenberg form using orthogonal transformations, where A */ -/* is a general matrix and B is upper triangular */ -La_extern void -F77_NAME(dgghrd)(const char* compq, const char* compz, const int* n, - const int* ilo, const int* ihi, double* a, const int* lda, - double* b, const int* ldb, double* q, const int* ldq, - double* z, const int* ldz, int* info); -/* DGGLSE - solve the linear equality-constrained least squares */ -/* (LSE) problem */ -La_extern void -F77_NAME(dgglse)(const int* m, const int* n, const int* p, - double* a, const int* lda, - double* b, const int* ldb, - double* c, double* d, double* x, - double* work, const int* lwork, int* info); -/* DGGQRF - compute a generalized QR factorization of an N-by-M */ -/* matrix A and an N-by-P matrix B */ -La_extern void -F77_NAME(dggqrf)(const int* n, const int* m, const int* p, - double* a, const int* lda, double* taua, - double* b, const int* ldb, double* taub, - double* work, const int* lwork, int* info); -/* DGGRQF - compute a generalized RQ factorization of an M-by-N */ -/* matrix A and a P-by-N matrix B */ -La_extern void -F77_NAME(dggrqf)(const int* m, const int* p, const int* n, - double* a, const int* lda, double* taua, - double* b, const int* ldb, double* taub, - double* work, const int* lwork, int* info); -/* DGGSVD - compute the generalized singular value decomposition */ -/* (GSVD) of an M-by-N real matrix A and P-by-N real matrix B */ -La_extern void -F77_NAME(dggsvd)(const char* jobu, const char* jobv, const char* jobq, - const int* m, const int* n, const int* p, - const int* k, const int* l, - double* a, const int* lda, - double* b, const int* ldb, - const double* alpha, const double* beta, - double* u, const int* ldu, - double* v, const int* ldv, - double* q, const int* ldq, - double* work, int* iwork, int* info); - -/* Double precision General Tridiagonal matrices */ - -/* DGTCON - estimate the reciprocal of the condition number of a real */ -/* tridiagonal matrix A using the LU factorization as computed by DGTTRF */ -La_extern void -F77_NAME(dgtcon)(const char* norm, const int* n, double* dl, double* d, - double* du, double* du2, int* ipiv, const double* anorm, - double* rcond, double* work, int* iwork, int* info); -/* DGTRFS - improve the computed solution to a system of linear equations */ -/* when the coefficient matrix is tridiagonal, and provides error bounds */ -/* and backward error estimates for the solution */ -La_extern void -F77_NAME(dgtrfs)(const char* trans, const int* n, const int* nrhs, - double* dl, double* d, double* du, double* dlf, - double* df, double* duf, double* du2, - int* ipiv, double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGTSV - solve the equation A*X = B, */ -La_extern void -F77_NAME(dgtsv)(const int* n, const int* nrhs, - double* dl, double* d, double* du, - double* b, const int* ldb, int* info); -/* DGTSVX - use the LU factorization to compute the solution to a */ -/* real system of linear equations A * X = B or A**T * X = B, */ -La_extern void -F77_NAME(dgtsvx)(const int* fact, const char* trans, - const int* n, const int* nrhs, - double* dl, double* d, double* du, - double* dlf, double* df, double* duf, - double* du2, int* ipiv, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGTTRF - compute an LU factorization of a real tridiagonal matrix */ -/* A using elimination with partial pivoting and row interchanges */ -La_extern void -F77_NAME(dgttrf)(const int* n, double* dl, double* d, - double* du, double* du2, int* ipiv, int* info); -/* DGTTRS - solve one of the systems of equations A*X = B or */ -/* A'*X = B, */ -La_extern void -F77_NAME(dgttrs)(const char* trans, const int* n, const int* nrhs, - double* dl, double* d, double* du, double* du2, - int* ipiv, double* b, const int* ldb, int* info); - -/* Double precision Orthogonal matrices */ - -/* DOPGTR - generate a real orthogonal matrix Q which is defined */ -/* as the product of n-1 elementary reflectors H(i); of order n, */ -/* as returned by DSPTRD using packed storage */ -La_extern void -F77_NAME(dopgtr)(const char* uplo, const int* n, - const double* ap, const double* tau, - double* q, const int* ldq, - double* work, int* info); -/* DOPMTR - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dopmtr)(const char* side, const char* uplo, - const char* trans, const int* m, const int* n, - const double* ap, const double* tau, - double* c, const int* ldc, - double* work, int* info); -/* DORG2L - generate an m by n real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorg2l)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, int* info); -/* DORG2R - generate an m by n real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorg2r)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, int* info); -/* DORGBR - generate one of the real orthogonal matrices Q or */ -/* P**T determined by DGEBRD when reducing a real matrix A to */ -/* bidiagonal form */ -La_extern void -F77_NAME(dorgbr)(const char* vect, const int* m, - const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, - const int* lwork, int* info); -/* DORGHR - generate a real orthogonal matrix Q which is defined */ -/* as the product of IHI-ILO elementary reflectors of order N, as */ -/* returned by DGEHRD */ -La_extern void -F77_NAME(dorghr)(const int* n, const int* ilo, const int* ihi, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORGL2 - generate an m by n real matrix Q with orthonormal */ -/* rows, */ -La_extern void -F77_NAME(dorgl2)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, int* info); -/* DORGLQ - generate an M-by-N real matrix Q with orthonormal */ -/* rows, */ -La_extern void -F77_NAME(dorglq)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, - const int* lwork, int* info); -/* DORGQL - generate an M-by-N real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorgql)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, - const int* lwork, int* info); -/* DORGQR - generate an M-by-N real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorgqr)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORGR2 - generate an m by n real matrix Q with orthonormal */ -/* rows, */ -La_extern void -F77_NAME(dorgr2)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, int* info); -/* DORGRQ - generate an M-by-N real matrix Q with orthonormal rows */ -La_extern void -F77_NAME(dorgrq)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORGTR - generate a real orthogonal matrix Q which is defined */ -/* as the product of n-1 elementary reflectors of order const int* n, as */ -/* returned by DSYTRD */ -La_extern void -F77_NAME(dorgtr)(const char* uplo, const int* n, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORM2L - overwrite the general real m by n matrix C with Q * */ -/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dorm2l)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, int* info); -/* DORM2R - overwrite the general real m by n matrix C with Q * C */ -/* if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dorm2r)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, double* work, int* info); -/* DORMBR - VECT = 'Q', DORMBR overwrites the general real M-by-N */ -/* matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormbr)(const char* vect, const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMHR - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormhr)(const char* side, const char* trans, const int* m, - const int* n, const int* ilo, const int* ihi, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORML2 - overwrite the general real m by n matrix C with Q * */ -/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dorml2)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, double* work, int* info); -/* DORMLQ - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormlq)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMQL - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormql)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMQR - overwrite the general real M-by-N matrix C with SIDE = */ -/* 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormqr)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMR2 - overwrite the general real m by n matrix C with Q * */ -/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dormr2)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, int* info); -/* DORMRQ - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormrq)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMTR - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormtr)(const char* side, const char* uplo, - const char* trans, const int* m, const int* n, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); - -/* Double precision Positive definite Band matrices */ - -/* DPBCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite band matrix */ -/* using the Cholesky factorization A = U**T*U or A = L*L**T */ -/* computed by DPBTRF */ -La_extern void -F77_NAME(dpbcon)(const char* uplo, const int* n, const int* kd, - const double* ab, const int* ldab, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DPBEQU - compute row and column scalings intended to */ -/* equilibrate a symmetric positive definite band matrix A and */ -/* reduce its condition number (with respect to the two-norm); */ -La_extern void -F77_NAME(dpbequ)(const char* uplo, const int* n, const int* kd, - const double* ab, const int* ldab, - double* s, double* scond, double* amax, int* info); -/* DPBRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite and banded, and provides error bounds and backward */ -/* error estimates for the solution */ -La_extern void -F77_NAME(dpbrfs)(const char* uplo, const int* n, - const int* kd, const int* nrhs, - const double* ab, const int* ldab, - const double* afb, const int* ldafb, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPBSTF - compute a split Cholesky factorization of a real */ -/* symmetric positive definite band matrix A */ -La_extern void -F77_NAME(dpbstf)(const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, int* info); -/* DPBSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dpbsv)(const char* uplo, const int* n, - const int* kd, const int* nrhs, - double* ab, const int* ldab, - double* b, const int* ldb, int* info); -/* DPBSVX - use the Cholesky factorization A = U**T*U or A = */ -/* L*L**T to compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dpbsvx)(const int* fact, const char* uplo, const int* n, - const int* kd, const int* nrhs, - double* ab, const int* ldab, - double* afb, const int* ldafb, - char* equed, double* s, - double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPBTF2 - compute the Cholesky factorization of a real */ -/* symmetric positive definite band matrix A */ -La_extern void -F77_NAME(dpbtf2)(const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, int* info); -/* DPBTRF - compute the Cholesky factorization of a real */ -/* symmetric positive definite band matrix A */ -La_extern void -F77_NAME(dpbtrf)(const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, int* info); -/* DPBTRS - solve a system of linear equations A*X = B with a */ -/* symmetric positive definite band matrix A using the Cholesky */ -/* factorization A = U**T*U or A = L*L**T computed by DPBTRF */ -La_extern void -F77_NAME(dpbtrs)(const char* uplo, const int* n, - const int* kd, const int* nrhs, - const double* ab, const int* ldab, - double* b, const int* ldb, int* info); - -/* Double precision Positive definite matrices */ - -/* DPOCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite matrix using */ -/* the Cholesky factorization A = U**T*U or A = L*L**T computed by */ -/* DPOTRF */ -La_extern void -F77_NAME(dpocon)(const char* uplo, const int* n, - const double* a, const int* lda, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DPOEQU - compute row and column scalings intended to */ -/* equilibrate a symmetric positive definite matrix A and reduce */ -/* its condition number (with respect to the two-norm); */ -La_extern void -F77_NAME(dpoequ)(const int* n, const double* a, const int* lda, - double* s, double* scond, double* amax, int* info); -/* DPORFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite, */ -La_extern void -F77_NAME(dporfs)(const char* uplo, const int* n, const int* nrhs, - const double* a, const int* lda, - const double* af, const int* ldaf, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPOSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dposv)(const char* uplo, const int* n, const int* nrhs, - double* a, const int* lda, - double* b, const int* ldb, int* info); -/* DPOSVX - use the Cholesky factorization A = U**T*U or A = */ -/* L*L**T to compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dposvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, - double* a, const int* lda, - double* af, const int* ldaf, char* equed, - double* s, double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, double* work, - int* iwork, int* info); -/* DPOTF2 - compute the Cholesky factorization of a real */ -/* symmetric positive definite matrix A */ -La_extern void -F77_NAME(dpotf2)(const char* uplo, const int* n, - double* a, const int* lda, int* info); -/* DPOTRF - compute the Cholesky factorization of a real */ -/* symmetric positive definite matrix A */ -La_extern void -F77_NAME(dpotrf)(const char* uplo, const int* n, - double* a, const int* lda, int* info); -/* DPOTRI - compute the inverse of a real symmetric positive */ -/* definite matrix A using the Cholesky factorization A = U**T*U */ -/* or A = L*L**T computed by DPOTRF */ -La_extern void -F77_NAME(dpotri)(const char* uplo, const int* n, - double* a, const int* lda, int* info); -/* DPOTRS - solve a system of linear equations A*X = B with a */ -/* symmetric positive definite matrix A using the Cholesky */ -/* factorization A = U**T*U or A = L*L**T computed by DPOTRF */ -La_extern void -F77_NAME(dpotrs)(const char* uplo, const int* n, - const int* nrhs, const double* a, const int* lda, - double* b, const int* ldb, int* info); -/* DPPCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite packed */ -/* matrix using the Cholesky factorization A = U**T*U or A = */ -/* L*L**T computed by DPPTRF */ -La_extern void -F77_NAME(dppcon)(const char* uplo, const int* n, - const double* ap, const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DPPEQU - compute row and column scalings intended to */ -/* equilibrate a symmetric positive definite matrix A in packed */ -/* storage and reduce its condition number (with respect to the */ -/* two-norm); */ -La_extern void -F77_NAME(dppequ)(const char* uplo, const int* n, - const double* ap, double* s, double* scond, - double* amax, int* info); - -/* Double precision Positive definite matrices in Packed storage */ - -/* DPPRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite and packed, and provides error bounds and backward */ -/* error estimates for the solution */ -La_extern void -F77_NAME(dpprfs)(const char* uplo, const int* n, const int* nrhs, - const double* ap, const double* afp, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPPSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dppsv)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - double* b, const int* ldb, int* info); -/* DPPSVX - use the Cholesky factorization A = U**T*U or A = */ -/* L*L**T to compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dppsvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, double* ap, - double* afp, char* equed, double* s, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPPTRF - compute the Cholesky factorization of a real */ -/* symmetric positive definite matrix A stored in packed format */ -La_extern void -F77_NAME(dpptrf)(const char* uplo, const int* n, double* ap, int* info); -/* DPPTRI - compute the inverse of a real symmetric positive */ -/* definite matrix A using the Cholesky factorization A = U**T*U */ -/* or A = L*L**T computed by DPPTRF */ -La_extern void -F77_NAME(dpptri)(const char* uplo, const int* n, double* ap, int* info); -/* DPPTRS - solve a system of linear equations A*X = B with a */ -/* symmetric positive definite matrix A in packed storage using */ -/* the Cholesky factorization A = U**T*U or A = L*L**T computed by */ -/* DPPTRF */ -La_extern void -F77_NAME(dpptrs)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - double* b, const int* ldb, int* info); - -/* Double precision symmetric Positive definite Tridiagonal matrices */ - -/* DPTCON - compute the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite tridiagonal */ -/* matrix using the factorization A = L*D*L**T or A = U**T*D*U */ -/* computed by DPTTRF */ -La_extern void -F77_NAME(dptcon)(const int* n, - const double* d, const double* e, - const double* anorm, double* rcond, - double* work, int* info); -/* DPTEQR - compute all eigenvalues and, optionally, eigenvectors */ -/* of a symmetric positive definite tridiagonal matrix by first */ -/* factoring the matrix using DPTTRF, and then calling DBDSQR to */ -/* compute the singular values of the bidiagonal factor */ -La_extern void -F77_NAME(dpteqr)(const char* compz, const int* n, double* d, - double* e, double* z, const int* ldz, - double* work, int* info); -/* DPTRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite and tridiagonal, and provides error bounds and */ -/* backward error estimates for the solution */ -La_extern void -F77_NAME(dptrfs)(const int* n, const int* nrhs, - const double* d, const double* e, - const double* df, const double* ef, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* info); -/* DPTSV - compute the solution to a real system of linear */ -/* equations A*X = B, where A is an N-by-N symmetric positive */ -/* definite tridiagonal matrix, and X and B are N-by-NRHS matrices */ -La_extern void -F77_NAME(dptsv)(const int* n, const int* nrhs, double* d, - double* e, double* b, const int* ldb, int* info); -/* DPTSVX - use the factorization A = L*D*L**T to compute the */ -/* solution to a real system of linear equations A*X = B, where A */ -/* is an N-by-N symmetric positive definite tridiagonal matrix and */ -/* X and B are N-by-NRHS matrices */ -La_extern void -F77_NAME(dptsvx)(const int* fact, const int* n, - const int* nrhs, - const double* d, const double* e, - double* df, double* ef, - const double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, - double* work, int* info); -/* DPTTRF - compute the factorization of a real symmetric */ -/* positive definite tridiagonal matrix A */ -La_extern void -F77_NAME(dpttrf)(const int* n, double* d, double* e, int* info); -/* DPTTRS - solve a system of linear equations A * X = B with a */ -/* symmetric positive definite tridiagonal matrix A using the */ -/* factorization A = L*D*L**T or A = U**T*D*U computed by DPTTRF */ -La_extern void -F77_NAME(dpttrs)(const int* n, const int* nrhs, - const double* d, const double* e, - double* b, const int* ldb, int* info); /* DRSCL - multiply an n-element real vector x by the real scalar */ /* 1/a */ La_extern void F77_NAME(drscl)(const int* n, const double* da, double* x, const int* incx); - -/* Double precision Symmetric Band matrices */ - -/* DSBEV - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric band matrix A */ -La_extern void -F77_NAME(dsbev)(const char* jobz, const char* uplo, - const int* n, const int* kd, - double* ab, const int* ldab, - double* w, double* z, const int* ldz, - double* work, int* info); -/* DSBEVD - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric band matrix A */ -La_extern void -F77_NAME(dsbevd)(const char* jobz, const char* uplo, - const int* n, const int* kd, - double* ab, const int* ldab, - double* w, double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSBEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric band matrix A */ -La_extern void -F77_NAME(dsbevx)(const char* jobz, const char* range, - const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, - double* q, const int* ldq, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); -/* DSBGST - reduce a real symmetric-definite banded generalized */ -/* eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y, */ -La_extern void -F77_NAME(dsbgst)(const char* vect, const char* uplo, - const int* n, const int* ka, const int* kb, - double* ab, const int* ldab, - double* bb, const int* ldbb, - double* x, const int* ldx, - double* work, int* info); -/* DSBGV - compute all the eigenvalues, and optionally, the */ -/* eigenvectors of a real generalized symmetric-definite banded */ -/* eigenproblem, of the form A*x=(lambda);*B*x */ -La_extern void -F77_NAME(dsbgv)(const char* jobz, const char* uplo, - const int* n, const int* ka, const int* kb, - double* ab, const int* ldab, - double* bb, const int* ldbb, - double* w, double* z, const int* ldz, - double* work, int* info); -/* DSBTRD - reduce a real symmetric band matrix A to symmetric */ -/* tridiagonal form T by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dsbtrd)(const char* vect, const char* uplo, - const int* n, const int* kd, - double* ab, const int* ldab, - double* d, double* e, - double* q, const int* ldq, - double* work, int* info); - -/* Double precision Symmetric Packed matrices */ - -/* DSPCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric packed matrix A using the */ -/* factorization A = U*D*U**T or A = L*D*L**T computed by DSPTRF */ -La_extern void -F77_NAME(dspcon)(const char* uplo, const int* n, - const double* ap, const int* ipiv, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DSPEV - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A in packed storage */ -La_extern void -F77_NAME(dspev)(const char* jobz, const char* uplo, const int* n, - double* ap, double* w, double* z, const int* ldz, - double* work, int* info); -/* DSPEVD - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A in packed storage */ -La_extern void -F77_NAME(dspevd)(const char* jobz, const char* uplo, - const int* n, double* ap, double* w, - double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSPEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A in packed storage */ -La_extern void -F77_NAME(dspevx)(const char* jobz, const char* range, - const char* uplo, const int* n, double* ap, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); -/* DSPGST - reduce a real symmetric-definite generalized */ -/* eigenproblem to standard form, using packed storage */ -La_extern void -F77_NAME(dspgst)(const int* itype, const char* uplo, - const int* n, double* ap, double* bp, int* info); -/* DSPGV - compute all the eigenvalues and, optionally, the */ -/* eigenvectors of a real generalized symmetric-definite */ -/* eigenproblem, of the form A*x=(lambda)*B*x, A*Bx=(lambda)*x, */ -/* or B*A*x=(lambda)*x */ -La_extern void -F77_NAME(dspgv)(const int* itype, const char* jobz, - const char* uplo, const int* n, - double* ap, double* bp, double* w, - double* z, const int* ldz, - double* work, int* info); - -/* DSPRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric indefinite */ -/* and packed, and provides error bounds and backward error */ -/* estimates for the solution */ -La_extern void -F77_NAME(dsprfs)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - const double* afp, const int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DSPSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dspsv)(const char* uplo, const int* n, - const int* nrhs, double* ap, int* ipiv, - double* b, const int* ldb, int* info); - -/* DSPSVX - use the diagonal pivoting factorization A = U*D*U**T */ -/* or A = L*D*L**T to compute the solution to a real system of */ -/* linear equations A * X = B, where A is an N-by-N symmetric */ -/* matrix stored in packed format and X and B are N-by-NRHS */ -/* matrices */ -La_extern void -F77_NAME(dspsvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, - const double* ap, double* afp, int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DSPTRD - reduce a real symmetric matrix A stored in packed */ -/* form to symmetric tridiagonal form T by an orthogonal */ -/* similarity transformation */ -La_extern void -F77_NAME(dsptrd)(const char* uplo, const int* n, - double* ap, double* d, double* e, - double* tau, int* info); - -/* DSPTRF - compute the factorization of a real symmetric matrix */ -/* A stored in packed format using the Bunch-Kaufman diagonal */ -/* pivoting method */ -La_extern void -F77_NAME(dsptrf)(const char* uplo, const int* n, - double* ap, int* ipiv, int* info); - -/* DSPTRI - compute the inverse of a real symmetric indefinite */ -/* matrix A in packed storage using the factorization A = U*D*U**T */ -/* or A = L*D*L**T computed by DSPTRF */ -La_extern void -F77_NAME(dsptri)(const char* uplo, const int* n, - double* ap, const int* ipiv, - double* work, int* info); - -/* DSPTRS - solve a system of linear equations A*X = B with a */ -/* real symmetric matrix A stored in packed format using the */ -/* factorization A = U*D*U**T or A = L*D*L**T computed by DSPTRF */ -La_extern void -F77_NAME(dsptrs)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - const int* ipiv, double* b, const int* ldb, int* info); - -/* Double precision Symmetric Tridiagonal matrices */ - -/* DSTEBZ - compute the eigenvalues of a symmetric tridiagonal */ -/* matrix T */ -La_extern void -F77_NAME(dstebz)(const char* range, const char* order, const int* n, - const double* vl, const double* vu, - const int* il, const int* iu, - const double *abstol, - const double* d, const double* e, - int* m, int* nsplit, double* w, - int* iblock, int* isplit, - double* work, int* iwork, - int* info); -/* DSTEDC - compute all eigenvalues and, optionally, eigenvectors */ -/* of a symmetric tridiagonal matrix using the divide and conquer */ -/* method */ -La_extern void -F77_NAME(dstedc)(const char* compz, const int* n, - double* d, double* e, - double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSTEIN - compute the eigenvectors of a real symmetric */ -/* tridiagonal matrix T corresponding to specified eigenvalues, */ -/* using inverse iteration */ -La_extern void -F77_NAME(dstein)(const int* n, const double* d, const double* e, - const int* m, const double* w, - const int* iblock, const int* isplit, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); -/* DSTEQR - compute all eigenvalues and, optionally, eigenvectors */ -/* of a symmetric tridiagonal matrix using the implicit QL or QR */ -/* method */ -La_extern void -F77_NAME(dsteqr)(const char* compz, const int* n, double* d, double* e, - double* z, const int* ldz, double* work, int* info); -/* DSTERF - compute all eigenvalues of a symmetric tridiagonal */ -/* matrix using the Pal-Walker-Kahan variant of the QL or QR */ -/* algorithm */ -La_extern void -F77_NAME(dsterf)(const int* n, double* d, double* e, int* info); -/* DSTEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric tridiagonal matrix A */ -La_extern void -F77_NAME(dstev)(const char* jobz, const int* n, - double* d, double* e, - double* z, const int* ldz, - double* work, int* info); -/* DSTEVD - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric tridiagonal matrix */ -La_extern void -F77_NAME(dstevd)(const char* jobz, const int* n, - double* d, double* e, - double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSTEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric tridiagonal matrix A */ -La_extern void -F77_NAME(dstevx)(const char* jobz, const char* range, - const int* n, double* d, double* e, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); - -/* Double precision SYmmetric matrices */ - -/* DSYCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric matrix A using the */ -/* factorization A = U*D*U**T or A = L*D*L**T computed by DSYTRF */ -La_extern void -F77_NAME(dsycon)(const char* uplo, const int* n, - const double* a, const int* lda, - const int* ipiv, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DSYEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyev)(const char* jobz, const char* uplo, - const int* n, double* a, const int* lda, - double* w, double* work, const int* lwork, int* info); -/* DSYEVD - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyevd)(const char* jobz, const char* uplo, - const int* n, double* a, const int* lda, - double* w, double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSYEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyevx)(const char* jobz, const char* range, - const char* uplo, const int* n, - double* a, const int* lda, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, const int* lwork, int* iwork, - int* ifail, int* info); -/* DSYEVR - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyevr)(const char *jobz, const char *range, const char *uplo, - const int *n, double *a, const int *lda, - const double *vl, const double *vu, - const int *il, const int *iu, - const double *abstol, int *m, double *w, - double *z, const int *ldz, int *isuppz, - double *work, const int *lwork, - int *iwork, const int *liwork, - int *info); -/* DSYGS2 - reduce a real symmetric-definite generalized */ -/* eigenproblem to standard form */ -La_extern void -F77_NAME(dsygs2)(const int* itype, const char* uplo, - const int* n, double* a, const int* lda, - const double* b, const int* ldb, int* info); -/* DSYGST - reduce a real symmetric-definite generalized */ -/* eigenproblem to standard form */ -La_extern void -F77_NAME(dsygst)(const int* itype, const char* uplo, - const int* n, double* a, const int* lda, - const double* b, const int* ldb, int* info); -/* DSYGV - compute all the eigenvalues, and optionally, the */ -/* eigenvectors of a real generalized symmetric-definite */ -/* eigenproblem, of the form A*x=(lambda);*B*x, A*Bx=(lambda);*x, */ -/* or B*A*x=(lambda);*x */ -La_extern void -F77_NAME(dsygv)(const int* itype, const char* jobz, - const char* uplo, const int* n, - double* a, const int* lda, - double* b, const int* ldb, - double* w, double* work, const int* lwork, - int* info); -/* DSYRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric indefinite, */ -/* and provides error bounds and backward error estimates for the */ -/* solution */ -La_extern void -F77_NAME(dsyrfs)(const char* uplo, const int* n, - const int* nrhs, - const double* a, const int* lda, - const double* af, const int* ldaf, - const int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DSYSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dsysv)(const char* uplo, const int* n, - const int* nrhs, - double* a, const int* lda, int* ipiv, - double* b, const int* ldb, - double* work, const int* lwork, int* info); - -/* DSYSVX - use the diagonal pivoting factorization to compute */ -/* the solution to a real system of linear equations A * X = B, */ -La_extern void -F77_NAME(dsysvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, - const double* a, const int* lda, - double* af, const int* ldaf, int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, - double* work, const int* lwork, - int* iwork, int* info); - -/* DSYTD2 - reduce a real symmetric matrix A to symmetric */ -/* tridiagonal form T by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dsytd2)(const char* uplo, const int* n, - double* a, const int* lda, - double* d, double* e, double* tau, - int* info); - -/* DSYTF2 - compute the factorization of a real symmetric matrix */ -/* A using the Bunch-Kaufman diagonal pivoting method */ -La_extern void -F77_NAME(dsytf2)(const char* uplo, const int* n, - double* a, const int* lda, - int* ipiv, int* info); - -/* DSYTRD - reduce a real symmetric matrix A to real symmetric */ -/* tridiagonal form T by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dsytrd)(const char* uplo, const int* n, - double* a, const int* lda, - double* d, double* e, double* tau, - double* work, const int* lwork, int* info); - -/* DSYTRF - compute the factorization of a real symmetric matrix */ -/* A using the Bunch-Kaufman diagonal pivoting method */ -La_extern void -F77_NAME(dsytrf)(const char* uplo, const int* n, - double* a, const int* lda, int* ipiv, - double* work, const int* lwork, int* info); - -/* DSYTRI - compute the inverse of a real symmetric indefinite */ -/* matrix A using the factorization A = U*D*U**T or A = L*D*L**T */ -/* computed by DSYTRF */ -La_extern void -F77_NAME(dsytri)(const char* uplo, const int* n, - double* a, const int* lda, const int* ipiv, - double* work, int* info); - -/* DSYTRS - solve a system of linear equations A*X = B with a */ -/* real symmetric matrix A using the factorization A = U*D*U**T or */ -/* A = L*D*L**T computed by DSYTRF */ -La_extern void -F77_NAME(dsytrs)(const char* uplo, const int* n, - const int* nrhs, - const double* a, const int* lda, - const int* ipiv, - double* b, const int* ldb, int* info); - -/* Double precision Triangular Band matrices */ - -/* DTBCON - estimate the reciprocal of the condition number of a */ -/* triangular band matrix A, in either the 1-norm or the */ -/* infinity-norm */ -La_extern void -F77_NAME(dtbcon)(const char* norm, const char* uplo, - const char* diag, const int* n, const int* kd, - const double* ab, const int* ldab, - double* rcond, double* work, - int* iwork, int* info); -/* DTBRFS - provide error bounds and backward error estimates for */ -/* the solution to a system of linear equations with a triangular */ -/* band coefficient matrix */ -La_extern void -F77_NAME(dtbrfs)(const char* uplo, const char* trans, - const char* diag, const int* n, const int* kd, - const int* nrhs, - const double* ab, const int* ldab, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DTBTRS - solve a triangular system of the form A * X = B or */ -/* A**T * X = B, */ -La_extern void -F77_NAME(dtbtrs)(const char* uplo, const char* trans, - const char* diag, const int* n, - const int* kd, const int* nrhs, - const double* ab, const int* ldab, - double* b, const int* ldb, int* info); - -/* Double precision Triangular matrices Generalized problems */ - -/* DTGEVC - compute some or all of the right and/or left */ -/* generalized eigenvectors of a pair of real upper triangular */ -/* matrices (A,B); */ -La_extern void -F77_NAME(dtgevc)(const char* side, const char* howmny, - const int* select, const int* n, - const double* a, const int* lda, - const double* b, const int* ldb, - double* vl, const int* ldvl, - double* vr, const int* ldvr, - const int* mm, int* m, double* work, int* info); - -/* DTGSJA - compute the generalized singular value decomposition */ -/* (GSVD); of two real upper triangular (or trapezoidal); matrices */ -/* A and B */ -La_extern void -F77_NAME(dtgsja)(const char* jobu, const char* jobv, const char* jobq, - const int* m, const int* p, const int* n, - const int* k, const int* l, - double* a, const int* lda, - double* b, const int* ldb, - const double* tola, const double* tolb, - double* alpha, double* beta, - double* u, const int* ldu, - double* v, const int* ldv, - double* q, const int* ldq, - double* work, int* ncycle, int* info); - -/* Double precision Triangular matrices Packed storage */ - -/* DTPCON - estimate the reciprocal of the condition number of a */ -/* packed triangular matrix A, in either the 1-norm or the */ -/* infinity-norm */ -La_extern void -F77_NAME(dtpcon)(const char* norm, const char* uplo, - const char* diag, const int* n, - const double* ap, double* rcond, - double* work, int* iwork, int* info); - -/* DTPRFS - provide error bounds and backward error estimates for */ -/* the solution to a system of linear equations with a triangular */ -/* packed coefficient matrix */ -La_extern void -F77_NAME(dtprfs)(const char* uplo, const char* trans, - const char* diag, const int* n, - const int* nrhs, const double* ap, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* Double precision TRiangular matrices */ - -/* DTPTRI - compute the inverse of a real upper or lower */ -/* triangular matrix A stored in packed format */ -La_extern void -F77_NAME(dtptri)(const char* uplo, const char* diag, - const int* n, double* ap, int* info); - -/* DTPTRS - solve a triangular system of the form A * X = B or */ -/* A**T * X = B, */ -La_extern void -F77_NAME(dtptrs)(const char* uplo, const char* trans, - const char* diag, const int* n, - const int* nrhs, const double* ap, - double* b, const int* ldb, int* info); - -/* DTRCON - estimate the reciprocal of the condition number of a */ -/* triangular matrix A, in either the 1-norm or the infinity-norm */ -La_extern void -F77_NAME(dtrcon)(const char* norm, const char* uplo, - const char* diag, const int* n, - const double* a, const int* lda, - double* rcond, double* work, - int* iwork, int* info); - -/* DTREVC - compute some or all of the right and/or left */ -/* eigenvectors of a real upper quasi-triangular matrix T */ -La_extern void -F77_NAME(dtrevc)(const char* side, const char* howmny, - const int* select, const int* n, - const double* t, const int* ldt, - double* vl, const int* ldvl, - double* vr, const int* ldvr, - const int* mm, int* m, double* work, int* info); - -/* DTREXC - reorder the real Schur factorization of a real matrix */ -/* A = Q*T*Q**T, so that the diagonal block of T with row index */ -/* IFST is moved to row ILST */ -La_extern void -F77_NAME(dtrexc)(const char* compq, const int* n, - double* t, const int* ldt, - double* q, const int* ldq, - int* ifst, int* ILST, - double* work, int* info); - -/* DTRRFS - provide error bounds and backward error estimates for */ -/* the solution to a system of linear equations with a triangular */ -/* coefficient matrix */ -La_extern void -F77_NAME(dtrrfs)(const char* uplo, const char* trans, - const char* diag, const int* n, const int* nrhs, - const double* a, const int* lda, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DTRSEN - reorder the real Schur factorization of a real matrix */ -/* A = Q*T*Q**T, so that a selected cluster of eigenvalues appears */ -/* in the leading diagonal blocks of the upper quasi-triangular */ -/* matrix T, */ -La_extern void -F77_NAME(dtrsen)(const char* job, const char* compq, - const int* select, const int* n, - double* t, const int* ldt, - double* q, const int* ldq, - double* wr, double* wi, - int* m, double* s, double* sep, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); - -/* DTRSNA - estimate reciprocal condition numbers for specified */ -/* eigenvalues and/or right eigenvectors of a real upper */ -/* quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q */ -/* orthogonal); */ -La_extern void -F77_NAME(dtrsna)(const char* job, const char* howmny, - const int* select, const int* n, - const double* t, const int* ldt, - const double* vl, const int* ldvl, - const double* vr, const int* ldvr, - double* s, double* sep, const int* mm, - int* m, double* work, const int* lwork, - int* iwork, int* info); - -/* DTRSYL - solve the real Sylvester matrix equation */ -La_extern void -F77_NAME(dtrsyl)(const char* trana, const char* tranb, - const int* isgn, const int* m, const int* n, - const double* a, const int* lda, - const double* b, const int* ldb, - double* c, const int* ldc, - double* scale, int* info); - -/* DTRTI2 - compute the inverse of a real upper or lower */ -/* triangular matrix */ -La_extern void -F77_NAME(dtrti2)(const char* uplo, const char* diag, - const int* n, double* a, const int* lda, - int* info); - -/* DTRTRI - compute the inverse of a real upper or lower */ -/* triangular matrix A */ -La_extern void -F77_NAME(dtrtri)(const char* uplo, const char* diag, - const int* n, double* a, const int* lda, - int* info); - -/* DTRTRS - solve a triangular system of the form A * X = B or */ -/* A**T * X = B */ -La_extern void -F77_NAME(dtrtrs)(const char* uplo, const char* trans, - const char* diag, const int* n, const int* nrhs, - const double* a, const int* lda, - double* b, const int* ldb, int* info); - -/* DTZRQF - reduce the M-by-N ( M<=N ); real upper trapezoidal */ -/* matrix A to upper triangular form by means of orthogonal */ -/* transformations */ -La_extern void -F77_NAME(dtzrqf)(const int* m, const int* n, - double* a, const int* lda, - double* tau, int* info); - - - -/* Double precision utilties in Lapack */ -/* DHGEQZ - implement a single-/double-shift version of the QZ */ -/* method for finding the generalized eigenvalues */ -/* w(j);=(ALPHAR(j); + i*ALPHAI(j););/BETAR(j); of the equation */ -/* det( A - w(i); B ); = 0 In addition, the pair A,B may be */ -/* reduced to generalized Schur form */ -La_extern void -F77_NAME(dhgeqz)(const char* job, const char* compq, const char* compz, - const int* n, const int *ILO, const int* IHI, - double* a, const int* lda, - double* b, const int* ldb, - double* alphar, double* alphai, const double* beta, - double* q, const int* ldq, - double* z, const int* ldz, - double* work, const int* lwork, int* info); -/* DHSEIN - use inverse iteration to find specified right and/or */ -/* left eigenvectors of a real upper Hessenberg matrix H */ -La_extern void -F77_NAME(dhsein)(const char* side, const char* eigsrc, - const char* initv, int* select, - const int* n, double* h, const int* ldh, - double* wr, double* wi, - double* vl, const int* ldvl, - double* vr, const int* ldvr, - const int* mm, int* m, double* work, - int* ifaill, int* ifailr, int* info); -/* DHSEQR - compute the eigenvalues of a real upper Hessenberg */ -/* matrix H and, optionally, the matrices T and Z from the Schur */ -/* decomposition H = Z T Z**T, where T is an upper */ -/* quasi-triangular matrix (the Schur form);, and Z is the */ -/* orthogonal matrix of Schur vectors */ -La_extern void -F77_NAME(dhseqr)(const char* job, const char* compz, const int* n, - const int* ilo, const int* ihi, - double* h, const int* ldh, - double* wr, double* wi, - double* z, const int* ldz, - double* work, const int* lwork, int* info); /* DLABAD - take as input the values computed by SLAMCH for */ /* underflow and overflow, and returns the square root of each of */ /* these values if the log of LARGE is sufficiently large */ @@ -1756,15 +224,6 @@ const int* n, double* d, double* q, const int* ldq, const double* rho, const double* dlamda, const double* w, double* s, const int* lds, int* info); -/* DLAEDA - compute the Z vector corresponding to the merge step */ -/* in the CURLVLth step of the merge process with TLVLS steps for */ -/* the CURPBMth problem */ -La_extern void -F77_NAME(dlaeda)(const int* n, const int* tlvls, const int* curlvl, - const int* curpbm, const int* prmptr, const int* perm, - const int* givptr, const int* givcol, - const double* givnum, const double* q, - const int* qptr, double* z, double* ztemp, int* info); /* DLAEIN - use inverse iteration to find a right or left */ /* eigenvector corresponding to the eigenvalue (WR,WI); of a real */ /* upper Hessenberg matrix H */ @@ -1811,13 +270,6 @@ const double* b1, const double* b2, const double* b3, double* csu, double* snu, double* csv, double* snv, double *csq, double *snq); -/* DLAGTF - factorize the matrix (T - lambda*I);, where T is an n */ -/* by n tridiagonal matrix and lambda is a scalar, as T - */ -/* lambda*I = PLU, */ -La_extern void -F77_NAME(dlagtf)(const int* n, double* a, const double* lambda, - double* b, double* c, const double *tol, - double* d, int* in, int* info); /* DLAGTM - perform a matrix-vector product of the form B := */ /* alpha * A * X + beta * B where A is a tridiagonal matrix of */ /* order N, B and X are N by NRHS matrices, and alpha and beta are */ @@ -1872,15 +324,6 @@ const double* wr, const double* wi, double* x, const int* ldx, double* scale, double* xnorm, int* info); -/* DLAMCH - determine double precision machine parameters */ -La_extern double -F77_NAME(dlamch)(const char* cmach); -/* DLAMRG - will create a permutation list which will merge the */ -/* elements of A (which is composed of two independently sorted */ -/* sets); into a single set which is sorted in ascending order */ -La_extern void -F77_NAME(dlamrg)(const int* n1, const int* n2, const double* a, - const int* dtrd1, const int* dtrd2, int* index); /* DLANGB - return the value of the one norm, or the Frobenius */ /* norm, or the infinity norm, or the element of largest absolute */ /* value of an n by n band matrix A, with kl sub-diagonals and ku */ @@ -1954,12 +397,6 @@ F77_NAME(dlantr)(const char* norm, const char* uplo, const char* diag, const int* m, const int* n, const double* a, const int* lda, double* work); -/* DLANV2 - compute the Schur factorization of a real 2-by-2 */ -/* nonsymmetric matrix in standard form */ -La_extern void -F77_NAME(dlanv2)(double* a, double* b, double* c, double* d, - double* rt1r, double* rt1i, double* rt2r, double* rt2i, - double* cs, double *sn); /* DLAPLL - two column vectors X and Y, let A = ( X Y ); */ La_extern void F77_NAME(dlapll)(const int* n, double* x, const int* incx, @@ -2088,13 +525,11 @@ /* uniform (0,1); */ La_extern void F77_NAME(dlaruv)(int* iseed, const int* n, double* x); - /* DLAS2 - compute the singular values of the 2-by-2 matrix */ /* [ F G ] [ 0 H ] */ La_extern void F77_NAME(dlas2)(const double* f, const double* g, const double* h, double* ssmin, double* ssmax); - /* DLASCL - multiply the M by N real matrix A by the real scalar */ /* CTO/CFROM */ La_extern void @@ -2103,7 +538,6 @@ double* cfrom, double* cto, const int* m, const int* n, double* a, const int* lda, int* info); - /* DLASET - initialize an m-by-n matrix A to BETA on the diagonal */ /* and ALPHA on the offdiagonals */ La_extern void @@ -2110,19 +544,6 @@ F77_NAME(dlaset)(const char* uplo, const int* m, const int* n, const double* alpha, const double* beta, double* a, const int* lda); -/* DLASQ1 - DLASQ1 computes the singular values of a real N-by-N */ -/* bidiagonal matrix with diagonal D and off-diagonal E */ -La_extern void -F77_NAME(dlasq1)(const int* n, double* d, double* e, - double* work, int* info); -/* DLASQ2 - DLASQ2 computes the singular values of a real N-by-N */ -/* unreduced bidiagonal matrix with squared diagonal elements in */ -/* Q and squared off-diagonal elements in E */ -La_extern void -F77_NAME(dlasq2)(const int* m, double* q, double* e, - double* qq, double* ee, const double* eps, - const double* tol2, const double* small2, - double* sup, int* kend, int* info); /* DLASQ3 - DLASQ3 is the workhorse of the whole bidiagonal SVD */ /* algorithm */ La_extern void @@ -2145,10 +566,6 @@ const char* direct, const int* m, const int* n, const double* c, const double* s, double* a, const int* lda); -/* DLASRT - the numbers in D in increasing order (if ID = 'I'); */ -/* or in decreasing order (if ID = 'D' ); */ -La_extern void -F77_NAME(dlasrt)(const char* id, const int* n, double* d, int* info); /* DLASSQ - return the values scl and smsq such that ( scl**2 */ /* );*smsq = x( 1 );**2 +...+ x( n );**2 + ( scale**2 );*sumsq, */ La_extern void @@ -2215,13 +632,6 @@ const char* diag, const char* normin, const int* n, const double* a, const int* lda, double* x, double* scale, double* cnorm, int* info); -/* DLATZM - apply a Householder matrix generated by DTZRQF to a */ -/* matrix */ -La_extern void -F77_NAME(dlatzm)(const char* side, const int* m, const int* n, - const double* v, const int* incv, - const double* tau, double* c1, double* c2, - const int* ldc, double* work); /* DLAUU2 - compute the product U * U' or L' * const int* l, where the */ /* triangular factor U or L is stored in the upper or lower */ /* triangular part of the array A */ @@ -2235,89 +645,11 @@ F77_NAME(dlauum)(const char* uplo, const int* n, double* a, const int* lda, int* info); - -/* ======================================================================== */ - -/* Selected Double Complex Lapack Routines - ======== - */ - /* IZMAX1 finds the index of the element whose real part has maximum * absolute value. */ La_extern int F77_NAME(izmax1)(const int *n, Rcomplex *cx, const int *incx); - -/* ZGECON estimates the reciprocal of the condition number of a general - * complex matrix A, in either the 1-norm or the infinity-norm, using - * the LU factorization computed by ZGETRF. - */ -La_extern void -F77_NAME(zgecon)(const char *norm, const int *n, - const Rcomplex *a, const int *lda, - const double *anorm, double *rcond, - Rcomplex *work, double *rwork, int *info); - -/* ZGESV computes the solution to a complex system of linear equations */ -La_extern void -F77_NAME(zgesv)(const int *n, const int *nrhs, Rcomplex *a, - const int *lda, int *ipiv, Rcomplex *b, - const int *ldb, int *info); - -/* ZGEQP3 computes a QR factorization with column pivoting */ -La_extern void -F77_NAME(zgeqp3)(const int *m, const int *n, - Rcomplex *a, const int *lda, - int *jpvt, Rcomplex *tau, - Rcomplex *work, const int *lwork, - double *rwork, int *info); - -/* ZUNMQR applies Q or Q**H from the Left or Right */ -La_extern void -F77_NAME(zunmqr)(const char *side, const char *trans, - const int *m, const int *n, const int *k, - Rcomplex *a, const int *lda, - Rcomplex *tau, - Rcomplex *c, const int *ldc, - Rcomplex *work, const int *lwork, int *info); - -/* ZTRTRS solves triangular systems */ -La_extern void -F77_NAME(ztrtrs)(const char *uplo, const char *trans, const char *diag, - const int *n, const int *nrhs, - Rcomplex *a, const int *lda, - Rcomplex *b, const int *ldb, int *info); -/* ZGESVD - compute the singular value decomposition (SVD); of a */ -/* real M-by-N matrix A, optionally computing the left and/or */ -/* right singular vectors */ -La_extern void -F77_NAME(zgesvd)(const char *jobu, const char *jobvt, - const int *m, const int *n, - Rcomplex *a, const int *lda, double *s, - Rcomplex *u, const int *ldu, - Rcomplex *vt, const int *ldvt, - Rcomplex *work, const int *lwork, double *rwork, - int *info); - -/* ZGHEEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a Hermitian matrix A */ -La_extern void -F77_NAME(zheev)(const char *jobz, const char *uplo, - const int *n, Rcomplex *a, const int *lda, - double *w, Rcomplex *work, const int *lwork, - double *rwork, int *info); - -/* ZGGEEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a complex non-symmetric matrix A */ -La_extern void -F77_NAME(zgeev)(const char *jobvl, const char *jobvr, - const int *n, Rcomplex *a, const int *lda, - Rcomplex *wr, Rcomplex *vl, const int *ldvl, - Rcomplex *vr, const int *ldvr, - Rcomplex *work, const int *lwork, - double *rwork, int *info); - - /* NOTE: The following entry points were traditionally in this file, but are not provided by R's libRlapack */ @@ -2325,7 +657,6 @@ /* vector and returns a double precision result */ La_extern double F77_NAME(dzsum1)(const int *n, Rcomplex *CX, const int *incx); - /* ZLACN2 estimates the 1-norm of a square, complex matrix A. * Reverse communication is used for evaluating matrix-vector products. */ @@ -2332,7 +663,6 @@ La_extern void F77_NAME(zlacn2)(const int *n, Rcomplex *v, Rcomplex *x, double *est, int *kase, int *isave); - /* ZLANTR - return the value of the one norm, or the Frobenius norm, */ /* or the infinity norm, or the element of largest absolute value of */ /* a trapezoidal or triangular matrix A */ @@ -2340,95 +670,15 @@ F77_NAME(zlantr)(const char *norm, const char *uplo, const char *diag, const int *m, const int *n, Rcomplex *a, const int *lda, double *work); - -/* ======================================================================== */ - -/* Other double precision and double complex Lapack routines - provided by libRlapack. - - These are extracted from the CLAPACK headers. -*/ - La_extern void -F77_NAME(dbdsdc)(char *uplo, char *compq, int *n, double * - d, double *e, double *u, int *ldu, double *vt, - int *ldvt, double *q, int *iq, double *work, int * iwork, int *info); - -La_extern void -F77_NAME(dgegs)(char *jobvsl, char *jobvsr, int *n, - double *a, int *lda, double *b, int *ldb, double * - alphar, double *alphai, double *beta, double *vsl, - int *ldvsl, double *vsr, int *ldvsr, double *work, - int *lwork, int *info); - -La_extern void -F77_NAME(dgelsd)(int *m, int *n, int *nrhs, - double *a, int *lda, double *b, int *ldb, double * - s, double *rcond, int *rank, double *work, int *lwork, - int *iwork, int *info); - -La_extern void -F77_NAME(dgelsx)(int *m, int *n, int *nrhs, - double *a, int *lda, double *b, int *ldb, int * - jpvt, double *rcond, int *rank, double *work, int * - info); - -La_extern void F77_NAME(dgesc2)(int *n, double *a, int *lda, double *rhs, int *ipiv, int *jpiv, double *scale); - -/* DGESDD - compute the singular value decomposition (SVD); of a */ -/* real M-by-N matrix A, optionally computing the left and/or */ -/* right singular vectors. If singular vectors are desired, it uses a */ -/* divide-and-conquer algorithm. */ La_extern void -F77_NAME(dgesdd)(const char *jobz, - const int *m, const int *n, - double *a, const int *lda, double *s, - double *u, const int *ldu, - double *vt, const int *ldvt, - double *work, const int *lwork, int *iwork, int *info); - -La_extern void F77_NAME(dgetc2)(int *n, double *a, int *lda, int *ipiv, int *jpiv, int *info); typedef int (*L_fp)(); La_extern void -F77_NAME(dggesx)(char *jobvsl, char *jobvsr, char *sort, L_fp - delctg, char *sense, int *n, double *a, int *lda, - double *b, int *ldb, int *sdim, double *alphar, - double *alphai, double *beta, double *vsl, int *ldvsl, - double *vsr, int *ldvsr, double *rconde, double * - rcondv, double *work, int *lwork, int *iwork, int * - liwork, int *bwork, int *info); - -La_extern void -F77_NAME(dggev)(char *jobvl, char *jobvr, int *n, double * - a, int *lda, double *b, int *ldb, double *alphar, - double *alphai, double *beta, double *vl, int *ldvl, - double *vr, int *ldvr, double *work, int *lwork, - int *info); - -La_extern void -F77_NAME(dggevx)(char *balanc, char *jobvl, char *jobvr, char * - sense, int *n, double *a, int *lda, double *b, - int *ldb, double *alphar, double *alphai, double * - beta, double *vl, int *ldvl, double *vr, int *ldvr, - int *ilo, int *ihi, double *lscale, double *rscale, - double *abnrm, double *bbnrm, double *rconde, double * - rcondv, double *work, int *lwork, int *iwork, int * - bwork, int *info); - -La_extern void -F77_NAME(dggsvp)(char *jobu, char *jobv, char *jobq, int *m, - int *p, int *n, double *a, int *lda, double *b, - int *ldb, double *tola, double *tolb, int *k, int - *l, double *u, int *ldu, double *v, int *ldv, - double *q, int *ldq, int *iwork, double *tau, - double *work, int *info); - -La_extern void F77_NAME(dgtts2)(int *itrans, int *n, int *nrhs, double *dl, double *d, double *du, double *du2, int *ipiv, double *b, int *ldb); @@ -2436,7 +686,6 @@ F77_NAME(dlagv2)(double *a, int *lda, double *b, int *ldb, double *alphar, double *alphai, double * beta, double *csl, double *snl, double *csr, double * snr); - La_extern void F77_NAME(dlals0)(int *icompq, int *nl, int *nr, int *sqre, int *nrhs, double *b, int *ldb, double @@ -2444,7 +693,6 @@ int *ldgcol, double *givnum, int *ldgnum, double * poles, double *difl, double *difr, double *z, int * k, double *c, double *s, double *work, int *info); - La_extern void F77_NAME(dlalsa)(int *icompq, int *smlsiz, int *n, int *nrhs, double *b, int *ldb, double *bx, int * @@ -2453,17 +701,14 @@ poles, int *givptr, int *givcol, int *ldgcol, int * perm, double *givnum, double *c, double *s, double * work, int *iwork, int *info); - La_extern void F77_NAME(dlalsd)(char *uplo, int *smlsiz, int *n, int *nrhs, double *d, double *e, double *b, int *ldb, double *rcond, int *rank, double *work, int *iwork, int *info); - La_extern void F77_NAME(dlamc1)(int *beta, int *t, int *rnd, int *ieee1); - La_extern void F77_NAME(dlamc2)(int *beta, int *t, int *rnd, double *eps, int *emin, double *rmin, int *emax, @@ -2522,22 +767,6 @@ int *isuppz, double *work, int *iwork, int *info); La_extern void -F77_NAME(dlarz)(char *side, int *m, int *n, int *l, - double *v, int *incv, double *tau, double *c, - int *ldc, double *work); - -La_extern void -F77_NAME(dlarzb)(char *side, char *trans, char *direct, char * - storev, int *m, int *n, int *k, int *l, double *v, - int *ldv, double *t, int *ldt, double *c, int * - ldc, double *work, int *ldwork); - -La_extern void -F77_NAME(dlarzt)(char *direct, char *storev, int *n, int * - k, double *v, int *ldv, double *tau, double *t, - int *ldt); - -La_extern void F77_NAME(dlasd0)(int *n, int *sqre, double *d, double *e, double *u, int *ldu, double *vt, int * ldvt, int *smlsiz, int *iwork, double *work, int * @@ -2641,78 +870,7 @@ La_extern void F77_NAME(dlatrz)(int *m, int *n, int *l, double * a, int *lda, double *tau, double *work); - La_extern void -F77_NAME(dormr3)(char *side, char *trans, int *m, int *n, - int *k, int *l, double *a, int *lda, double *tau, - double *c, int *ldc, double *work, int *info); - -La_extern void -F77_NAME(dormrz)(char *side, char *trans, int *m, int *n, - int *k, int *l, double *a, int *lda, double *tau, - double *c, int *ldc, double *work, int *lwork, - int *info); - -La_extern void -F77_NAME(dptts2)(int *n, int *nrhs, double *d, - double *e, double *b, int *ldb); - -La_extern void -F77_NAME(dsbgvd)(char *jobz, char *uplo, int *n, int *ka, - int *kb, double *ab, int *ldab, double *bb, int * - ldbb, double *w, double *z, int *ldz, double *work, - int *lwork, int *iwork, int *liwork, int *info); - -La_extern void -F77_NAME(dsbgvx)(char *jobz, char *range, char *uplo, int *n, - int *ka, int *kb, double *ab, int *ldab, double * - bb, int *ldbb, double *q, int *ldq, double *vl, - double *vu, int *il, int *iu, double *abstol, int - *m, double *w, double *z, int *ldz, double *work, - int *iwork, int *ifail, int *info); - -La_extern void -F77_NAME(dspgvd)(int *itype, char *jobz, char *uplo, int * - n, double *ap, double *bp, double *w, double *z, - int *ldz, double *work, int *lwork, int *iwork, - int *liwork, int *info); - -La_extern void -F77_NAME(dspgvx)(int *itype, char *jobz, char *range, char * - uplo, int *n, double *ap, double *bp, double *vl, - double *vu, int *il, int *iu, double *abstol, int - *m, double *w, double *z, int *ldz, double *work, - int *iwork, int *ifail, int *info); - -La_extern void -F77_NAME(dstegr)(char *jobz, char *range, int *n, double * - d, double *e, double *vl, double *vu, int *il, - int *iu, double *abstol, int *m, double *w, - double *z, int *ldz, int *isuppz, double *work, - int *lwork, int *iwork, int *liwork, int *info); - -La_extern void -F77_NAME(dstevr)(char *jobz, char *range, int *n, double * - d, double *e, double *vl, double *vu, int *il, - int *iu, double *abstol, int *m, double *w, - double *z, int *ldz, int *isuppz, double *work, - int *lwork, int *iwork, int *liwork, int *info); - -La_extern void -F77_NAME(dsygvd)(int *itype, char *jobz, char *uplo, int * - n, double *a, int *lda, double *b, int *ldb, - double *w, double *work, int *lwork, int *iwork, - int *liwork, int *info); - -La_extern void -F77_NAME(dsygvx)(int *itype, char *jobz, char *range, char * - uplo, int *n, double *a, int *lda, double *b, int - *ldb, double *vl, double *vu, int *il, int *iu, - double *abstol, int *m, double *w, double *z, - int *ldz, double *work, int *lwork, int *iwork, - int *ifail, int *info); - -La_extern void F77_NAME(dtgex2)(int *wantq, int *wantz, int *n, double *a, int *lda, double *b, int *ldb, double * q, int *ldq, double *z, int *ldz, int *j1, int * @@ -2719,28 +877,6 @@ n1, int *n2, double *work, int *lwork, int *info); La_extern void -F77_NAME(dtgexc)(int *wantq, int *wantz, int *n, - double *a, int *lda, double *b, int *ldb, double * - q, int *ldq, double *z, int *ldz, int *ifst, - int *ilst, double *work, int *lwork, int *info); - -La_extern void -F77_NAME(dtgsen)(int *ijob, int *wantq, int *wantz, - int *select, int *n, double *a, int *lda, double * - b, int *ldb, double *alphar, double *alphai, double * - beta, double *q, int *ldq, double *z, int *ldz, - int *m, double *pl, double *pr, double *dif, - double *work, int *lwork, int *iwork, int *liwork, - int *info); - -La_extern void -F77_NAME(dtgsna)(char *job, char *howmny, int *select, - int *n, double *a, int *lda, double *b, int *ldb, - double *vl, int *ldvl, double *vr, int *ldvr, - double *s, double *dif, int *mm, int *m, double * - work, int *lwork, int *iwork, int *info); - -La_extern void F77_NAME(dtgsy2)(char *trans, int *ijob, int *m, int * n, double *a, int *lda, double *b, int *ldb, double *c, int *ldc, double *d, int *ldd, @@ -2749,108 +885,27 @@ *pq, int *info); La_extern void -F77_NAME(dtgsyl)(char *trans, int *ijob, int *m, int * - n, double *a, int *lda, double *b, int *ldb, - double *c, int *ldc, double *d, int *ldd, - double *e, int *lde, double *f, int *ldf, double * - scale, double *dif, double *work, int *lwork, int * - iwork, int *info); - -La_extern void -F77_NAME(dtzrzf)(int *m, int *n, double *a, int * - lda, double *tau, double *work, int *lwork, int *info); - - -La_extern int -F77_NAME(lsame)(char *ca, char *cb); - -La_extern void -F77_NAME(zbdsqr)(char *uplo, int *n, int *ncvt, int * - nru, int *ncc, double *d, double *e, Rcomplex *vt, - int *ldvt, Rcomplex *u, int *ldu, Rcomplex *c, - int *ldc, double *rwork, int *info); - -La_extern void -F77_NAME(zdrot)(int *n, Rcomplex *cx, int *incx, - Rcomplex *cy, int *incy, double *c, double *s); - -La_extern void -F77_NAME(zgebak)(char *job, char *side, int *n, int *ilo, - int *ihi, double *scale, int *m, Rcomplex *v, - int *ldv, int *info); - -La_extern void -F77_NAME(zgebal)(char *job, int *n, Rcomplex *a, int - *lda, int *ilo, int *ihi, double *scale, int *info); - -La_extern void F77_NAME(zgebd2)(int *m, int *n, Rcomplex *a, int *lda, double *d, double *e, Rcomplex *tauq, Rcomplex *taup, Rcomplex *work, int *info); - La_extern void -F77_NAME(zgebrd)(int *m, int *n, Rcomplex *a, - int *lda, double *d, double *e, Rcomplex *tauq, - Rcomplex *taup, Rcomplex *work, int *lwork, int * - info); -La_extern void F77_NAME(zgehd2)(int *n, int *ilo, int *ihi, Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * work, int *info); La_extern void -F77_NAME(zgehrd)(int *n, int *ilo, int *ihi, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void F77_NAME(zgelq2)(int *m, int *n, Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex *work, int *info); La_extern void -F77_NAME(zgelqf)(int *m, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, - int *info); - -La_extern void F77_NAME(zgeqr2)(int *m, int *n, Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex *work, int *info); La_extern void -F77_NAME(zgeqrf)(int *m, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, - int *info); - -La_extern void -F77_NAME(zgetf2)(int *m, int *n, Rcomplex *a, - int *lda, int *ipiv, int *info); - -La_extern void -F77_NAME(zgetrf)(int *m, int *n, Rcomplex *a, - int *lda, int *ipiv, int *info); - -La_extern void -F77_NAME(zgetrs)(char *trans, int *n, int *nrhs, - Rcomplex *a, int *lda, int *ipiv, Rcomplex *b, - int *ldb, int *info); - - -La_extern void F77_NAME(zhetd2)(char *uplo, int *n, Rcomplex *a, int *lda, double *d, double *e, Rcomplex *tau, int *info); La_extern void -F77_NAME(zhetrd)(char *uplo, int *n, Rcomplex *a, - int *lda, double *d, double *e, Rcomplex *tau, - Rcomplex *work, int *lwork, int *info); - -La_extern void -F77_NAME(zhseqr)(char *job, char *compz, int *n, int *ilo, - int *ihi, Rcomplex *h, int *ldh, Rcomplex *w, - Rcomplex *z, int *ldz, Rcomplex *work, int *lwork, - int *info); - -La_extern void F77_NAME(zlabrd)(int *m, int *n, int *nb, Rcomplex *a, int *lda, double *d, double *e, Rcomplex *tauq, Rcomplex *taup, Rcomplex *x, int * @@ -2956,101 +1011,9 @@ double *scale, double *cnorm, int *info); La_extern void -F77_NAME(zsteqr)(char *compz, int *n, double *d, - double *e, Rcomplex *z, int *ldz, double *work, - int *info); - -/* ZTRCON estimates the reciprocal of the condition number of a - * triangular matrix A, in either the 1-norm or the infinity-norm. - */ -La_extern void -F77_NAME(ztrcon)(const char *norm, const char *uplo, const char *diag, - const int *n, const Rcomplex *a, const int *lda, - double *rcond, Rcomplex *work, double *rwork, int *info); - -La_extern void -F77_NAME(ztrevc)(char *side, char *howmny, int *select, - int *n, Rcomplex *t, int *ldt, Rcomplex *vl, - int *ldvl, Rcomplex *vr, int *ldvr, int *mm, int - *m, Rcomplex *work, double *rwork, int *info); - -La_extern void -F77_NAME(zung2l)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zung2r)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zungbr)(char *vect, int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zunghr)(int *n, int *ilo, int *ihi, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungl2)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zunglq)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungql)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungqr)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungr2)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zungrq)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungtr)(char *uplo, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, - int *info); - -La_extern void F77_NAME(zunm2r)(char *side, char *trans, int *m, int *n, int *k, Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex *c, int *ldc, Rcomplex *work, int *info); - -La_extern void -F77_NAME(zunmbr)(char *vect, char *side, char *trans, int *m, - int *n, int *k, Rcomplex *a, int *lda, Rcomplex - *tau, Rcomplex *c, int *ldc, Rcomplex *work, int * - lwork, int *info); - -La_extern void -F77_NAME(zunml2)(char *side, char *trans, int *m, int *n, - int *k, Rcomplex *a, int *lda, Rcomplex *tau, - Rcomplex *c, int *ldc, Rcomplex *work, int *info); - -La_extern void -F77_NAME(zunmlq)(char *side, char *trans, int *m, int *n, - int *k, Rcomplex *a, int *lda, Rcomplex *tau, - Rcomplex *c, int *ldc, Rcomplex *work, int *lwork, - int *info); - #ifdef __cplusplus } #endif --- R-2.10.1/src/modules/lapack/Lapack.c.orig Mon Sep 22 00:05:27 2008 +++ R-2.10.1/src/modules/lapack/Lapack.c Tue Dec 29 05:49:27 2009 @@ -34,39 +34,26 @@ * 2) Pkgs cannot get it from the C-Lapack interface code {lapack.so} * since that is R-internal */ -char La_norm_type(const char *typstr) +char La_norm_type(const char typstr) { - char typup; - - if (strlen(typstr) != 1) - error( - _("argument type[1]='%s' must be a character string of string length 1"), - typstr); - typup = toupper(*typstr); + char typup = toupper(typstr); if (typup == '1') typup = 'O'; /* aliases */ else if (typup == 'E') typup = 'F'; else if (typup != 'M' && typup != 'O' && typup != 'I' && typup != 'F') - error(_("argument type[1]='%s' must be one of 'M','1','O','I','F' or 'E'"), - typstr); + error(_("argument '%c' must be one of 'M','1','O','I','F' or 'E'"), typstr); return typup; } /* Lapack condition number approximation: currently only supports _1 or _Inf norm : */ -char La_rcond_type(const char *typstr) +char La_rcond_type(const char typstr) { - char typup; - - if (strlen(typstr) != 1) - error(_("argument type[1]='%s' must be a character string of string length 1"), - typstr); - typup = toupper(*typstr); + char typup = toupper(typstr); if (typup == '1') typup = 'O'; /* alias */ else if (typup != 'O' && typup != 'I') - error(_("argument type[1]='%s' must be one of '1','O', or 'I'"), - typstr); + error(_("argument '%c' must be one of '1','O', or 'I'"), typstr); return typup; /* 'O' or 'I' */ } @@ -74,16 +61,14 @@ static SEXP modLa_svd(SEXP jobu, SEXP jobv, SEXP x, SEXP s, SEXP u, SEXP v, SEXP method) { - int *xdims, n, p, lwork, info = 0; - double *work, *xvals, tmp; + int *xdims, n, p, info = 0; + double *xvals; SEXP val, nm; - const char *meth; if (!(isString(jobu) && isString(jobv))) error(_("'jobu' and 'jobv' must be character strings")); if (!isString(method)) error(_("'method' must be a character string")); - meth = CHAR(STRING_ELT(method, 0)); xdims = INTEGER(coerceVector(getAttrib(x, R_DimSymbol), INTSXP)); n = xdims[0]; p = xdims[1]; xvals = (double *) R_alloc(n * p, sizeof(double)); @@ -93,26 +78,11 @@ { int ldu = INTEGER(getAttrib(u, R_DimSymbol))[0], ldvt = INTEGER(getAttrib(v, R_DimSymbol))[0]; - int *iwork= (int *) R_alloc(8*(n

4*n) ? m : 4*n, + work = (double *) R_alloc((typNorm == 'I' && m > 4*n) ? m : 4*n, sizeof(double)); iwork = (int *) R_alloc(m, sizeof(int)); - anorm = F77_CALL(dlange)(typNorm, &m, &n, REAL(x), &m, work); + /* hopefully it has the same interfaces in sunperf */ + anorm = F77_CALL(dlange)(&typNorm, &m, &n, REAL(x), &m, work); /* Compute the LU-decomposition and overwrite 'x' with result :*/ - F77_CALL(dgetrf)(&m, &n, REAL(x), &m, iwork, &info); + SPL_CALL(dgetrf)(m, n, REAL(x), m, iwork, &info); if (info) { if (info < 0) { UNPROTECT(2); @@ -350,9 +295,8 @@ return val; } } - F77_CALL(dgecon)(typNorm, &n, REAL(x), &n, &anorm, - /* rcond = */ REAL(val), - work, iwork, &info); + SPL_CALL(dgecon)(typNorm, n, REAL(x), n, anorm, + /* rcond = */ REAL(val), &info); UNPROTECT(2); if (info) error(_("error [%d] from Lapack 'dgecon()'"), info); return val; @@ -362,7 +306,7 @@ { SEXP x, val; int *xdims, n, nprot = 0, info; - char typNorm[] = {'\0', '\0'}; + char typNorm; if (!isString(norm)) error(_("'norm' must be a character string")); @@ -382,16 +326,13 @@ error(_("'A' must be a *square* matrix")); } - typNorm[0] = La_rcond_type(CHAR(asChar(norm))); + typNorm = La_rcond_type(*CHAR(asChar(norm))); nprot++; val = PROTECT(allocVector(REALSXP, 1)); - F77_CALL(dtrcon)(typNorm, "U", "N", &n, REAL(x), &n, - REAL(val), - /* work : */ (double *) R_alloc(3*n, sizeof(double)), - /* iwork: */ (int *) R_alloc(n, sizeof(int)), - &info); + SPL_CALL(dtrcon)(typNorm, 'U', 'N', n, REAL(x), n, + REAL(val), &info); UNPROTECT(nprot); if (info) error(_("error [%d] from Lapack 'dtrcon()'"), info); return val; @@ -404,7 +345,7 @@ Rcomplex *avals; /* copy of A, to be modified */ int *dims, n, info; double anorm, *rwork; - char typNorm[] = {'\0', '\0'}; + char typNorm; if (!isString(norm)) error(_("'norm' must be a character string")); @@ -415,18 +356,19 @@ if(n != dims[1]) error(_("'A' must be a *square* matrix")); - typNorm[0] = La_rcond_type(CHAR(asChar(norm))); + typNorm = La_rcond_type(*CHAR(asChar(norm))); val = PROTECT(allocVector(REALSXP, 1)); rwork = (double *) R_alloc(2*n, sizeof(Rcomplex)); - anorm = F77_CALL(zlange)(typNorm, &n, &n, COMPLEX(A), &n, rwork); + /* hopefully same interface in sunperf */ + anorm = F77_CALL(zlange)(&typNorm, &n, &n, COMPLEX(A), &n, rwork); /* Compute the LU-decomposition and overwrite 'x' with result; * working on a copy of A : */ avals = (Rcomplex *) R_alloc(n * n, sizeof(Rcomplex)); Memcpy(avals, COMPLEX(A), n * n); - F77_CALL(zgetrf)(&n, &n, avals, &n, + SPL_CALL(zgetrf)(n, n, avals, n, /* iwork: */(int *) R_alloc(n, sizeof(int)), &info); if (info) { @@ -434,10 +376,7 @@ error(_("error [%d] from Lapack 'zgetrf()'"), info); } - F77_CALL(zgecon)(typNorm, &n, avals, &n, &anorm, - /* rcond = */ REAL(val), - /* work : */ (Rcomplex *) R_alloc(4*n, sizeof(Rcomplex)), - rwork, &info); + SPL_CALL(zgecon)(typNorm, n, avals, n, anorm, REAL(val), &info); UNPROTECT(1); if (info) error(_("error [%d] from Lapack 'zgecon()'"), info); return val; @@ -453,7 +392,7 @@ #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX SEXP val; int *dims, n, info; - char typNorm[] = {'\0', '\0'}; + char typNorm; if (!isString(norm)) error(_("'norm' must be a character string")); @@ -464,15 +403,12 @@ if(n != dims[1]) error(_("'A' must be a *square* matrix")); - typNorm[0] = La_rcond_type(CHAR(asChar(norm))); + typNorm = La_rcond_type(*CHAR(asChar(norm))); val = PROTECT(allocVector(REALSXP, 1)); - F77_CALL(ztrcon)(typNorm, "U", "N", &n, COMPLEX(A), &n, - REAL(val), - /* work : */ (Rcomplex *) R_alloc(2*n, sizeof(Rcomplex)), - /* rwork: */ (double *) R_alloc(n, sizeof(double)), - &info); + SPL_CALL(ztrcon)(typNorm, 'U', 'N', n, COMPLEX(A), n, + REAL(val), &info); UNPROTECT(1); if (info) error(_("error [%d] from Lapack 'ztrcon()'"), info); return val; @@ -512,7 +448,7 @@ avals = (Rcomplex *) R_alloc(n * n, sizeof(Rcomplex)); /* work on a copy of x */ Memcpy(avals, COMPLEX(A), n * n); - F77_CALL(zgesv)(&n, &p, avals, &n, ipiv, COMPLEX(B), &n, &info); + SPL_CALL(zgesv)(n, p, avals, n, ipiv, COMPLEX(B), n, &info); if (info < 0) error(_("argument %d of Lapack routine %s had invalid value"), -info, "zgesv"); @@ -529,9 +465,7 @@ static SEXP modLa_zgeqp3(SEXP Ain) { #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX - int i, m, n, *Adims, info, lwork; - Rcomplex *work, tmp; - double *rwork; + int i, m, n, *Adims, info; SEXP val, nm, jpvt, tau, rank, A; if (!(isMatrix(Ain) && isComplex(Ain))) @@ -540,22 +474,13 @@ Adims = INTEGER(coerceVector(getAttrib(A, R_DimSymbol), INTSXP)); m = Adims[0]; n = Adims[1]; - rwork = (double *) R_alloc(2*n, sizeof(double)); jpvt = PROTECT(allocVector(INTSXP, n)); for (i = 0; i < n; i++) INTEGER(jpvt)[i] = 0; tau = PROTECT(allocVector(CPLXSXP, m < n ? m : n)); - lwork = -1; - F77_CALL(zgeqp3)(&m, &n, COMPLEX(A), &m, INTEGER(jpvt), COMPLEX(tau), - &tmp, &lwork, rwork, &info); + SPL_CALL(zgeqp3)(m, n, COMPLEX(A), m, INTEGER(jpvt), COMPLEX(tau), &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "zgeqp3"); - lwork = (int) tmp.r; - work = (Rcomplex *) R_alloc(lwork, sizeof(Rcomplex)); - F77_CALL(zgeqp3)(&m, &n, COMPLEX(A), &m, INTEGER(jpvt), COMPLEX(tau), - work, &lwork, rwork, &info); - if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "zgeqp3"); val = PROTECT(allocVector(VECSXP, 4)); nm = PROTECT(allocVector(STRSXP, 4)); rank = PROTECT(ScalarInteger(m < n ? m : n)); @@ -579,9 +504,8 @@ static SEXP modqr_coef_cmplx(SEXP Q, SEXP Bin) { #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX - int n, nrhs, lwork, info, k, *Bdims, *Qdims; + int n, nrhs, info, k, *Bdims, *Qdims; SEXP B, qr=VECTOR_ELT(Q, 0), tau=VECTOR_ELT(Q, 2); - Rcomplex *work, tmp; k = LENGTH(tau); if (!(isMatrix(Bin) && isComplex(Bin))) @@ -594,22 +518,13 @@ if(Bdims[0] != n) error(_("right-hand side should have %d not %d rows"), n, Bdims[0]); nrhs = Bdims[1]; - lwork = -1; - F77_CALL(zunmqr)("L", "C", &n, &nrhs, &k, - COMPLEX(qr), &n, COMPLEX(tau), COMPLEX(B), &n, - &tmp, &lwork, &info); + SPL_CALL(zunmqr)('L', 'C', n, nrhs, k, + COMPLEX(qr), n, COMPLEX(tau), COMPLEX(B), n, &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "zunmqr"); - lwork = (int) tmp.r; - work = (Rcomplex *) R_alloc(lwork, sizeof(Rcomplex)); - F77_CALL(zunmqr)("L", "C", &n, &nrhs, &k, - COMPLEX(qr), &n, COMPLEX(tau), COMPLEX(B), &n, - work, &lwork, &info); + SPL_CALL(ztrtrs)('U', 'N', 'N', k, nrhs, + COMPLEX(qr), n, COMPLEX(B), n, &info); if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "zunmqr"); - F77_CALL(ztrtrs)("U", "N", "N", &k, &nrhs, - COMPLEX(qr), &n, COMPLEX(B), &n, &info); - if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "ztrtrs"); UNPROTECT(1); return B; @@ -622,9 +537,8 @@ static SEXP modqr_qy_cmplx(SEXP Q, SEXP Bin, SEXP trans) { #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX - int n, nrhs, lwork, info, k, *Bdims, *Qdims, tr; + int n, nrhs, info, k, *Bdims, *Qdims, tr; SEXP B, qr=VECTOR_ELT(Q, 0), tau=VECTOR_ELT(Q, 2); - Rcomplex *work, tmp; k = LENGTH(tau); if (!(isMatrix(Bin) && isComplex(Bin))) @@ -639,19 +553,10 @@ if(Bdims[0] != n) error(_("right-hand side should have %d not %d rows"), n, Bdims[0]); nrhs = Bdims[1]; - lwork = -1; - F77_CALL(zunmqr)("L", tr ? "C" : "N", &n, &nrhs, &k, - COMPLEX(qr), &n, COMPLEX(tau), COMPLEX(B), &n, - &tmp, &lwork, &info); + SPL_CALL(zunmqr)('L', tr ? 'C' : 'N', n, nrhs, k, + COMPLEX(qr), n, COMPLEX(tau), COMPLEX(B), n, &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "zunmqr"); - lwork = (int) tmp.r; - work = (Rcomplex *) R_alloc(lwork, sizeof(Rcomplex)); - F77_CALL(zunmqr)("L", tr ? "C" : "N", &n, &nrhs, &k, - COMPLEX(qr), &n, COMPLEX(tau), COMPLEX(B), &n, - work, &lwork, &info); - if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "zunmqr"); UNPROTECT(1); return B; #else @@ -663,9 +568,7 @@ static SEXP modLa_svd_cmplx(SEXP jobu, SEXP jobv, SEXP xin, SEXP s, SEXP u, SEXP v) { #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX - int *xdims, n, p, lwork, info; - double *rwork; - Rcomplex *work, tmp; + int *xdims, n, p, info; SEXP x, val, nm; if (!(isString(jobu) && isString(jobv))) @@ -673,25 +576,13 @@ PROTECT(x = duplicate(xin)); xdims = INTEGER(coerceVector(getAttrib(x, R_DimSymbol), INTSXP)); n = xdims[0]; p = xdims[1]; - rwork = (double *) R_alloc(5*(n < p ? n:p), sizeof(double)); - /* ask for optimal size of work array */ - lwork = -1; - F77_CALL(zgesvd)(CHAR(STRING_ELT(jobu, 0)), CHAR(STRING_ELT(jobv, 0)), - &n, &p, COMPLEX(x), &n, REAL(s), - COMPLEX(u), INTEGER(getAttrib(u, R_DimSymbol)), - COMPLEX(v), INTEGER(getAttrib(v, R_DimSymbol)), - &tmp, &lwork, rwork, &info); + SPL_CALL(zgesvd)(*CHAR(STRING_ELT(jobu, 0)), *CHAR(STRING_ELT(jobv, 0)), + n, p, COMPLEX(x), n, REAL(s), + COMPLEX(u), *INTEGER(getAttrib(u, R_DimSymbol)), + COMPLEX(v), *INTEGER(getAttrib(v, R_DimSymbol)), + &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "zgesvd"); - lwork = (int) tmp.r; - work = (Rcomplex *) R_alloc(lwork, sizeof(Rcomplex)); - F77_CALL(zgesvd)(CHAR(STRING_ELT(jobu, 0)), CHAR(STRING_ELT(jobv, 0)), - &n, &p, COMPLEX(x), &n, REAL(s), - COMPLEX(u), INTEGER(getAttrib(u, R_DimSymbol)), - COMPLEX(v), INTEGER(getAttrib(v, R_DimSymbol)), - work, &lwork, rwork, &info); - if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "zgesvd"); val = PROTECT(allocVector(VECSXP, 3)); nm = PROTECT(allocVector(STRSXP, 3)); SET_STRING_ELT(nm, 0, mkChar("d")); @@ -712,15 +603,14 @@ static SEXP modLa_rs_cmplx(SEXP xin, SEXP only_values) { #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX - int *xdims, n, lwork, info, ov; - char jobv[1], uplo[1]; + int *xdims, n, info, ov; + char jobv; SEXP values, ret, nm, x; - Rcomplex *work, *rx, tmp; - double *rwork, *rvalues; + Rcomplex *rx; + double *rvalues; PROTECT(x = duplicate(xin)); rx = COMPLEX(x); - uplo[0] = 'L'; xdims = INTEGER(coerceVector(getAttrib(x, R_DimSymbol), INTSXP)); n = xdims[0]; if (n != xdims[1]) @@ -727,23 +617,13 @@ error(_("'x' must be a square numeric matrix")); ov = asLogical(only_values); if (ov == NA_LOGICAL) error(_("invalid '%s' argument"), "only.values"); - if (ov) jobv[0] = 'N'; else jobv[0] = 'V'; + jobv = ov ? 'N' : 'V'; PROTECT(values = allocVector(REALSXP, n)); rvalues = REAL(values); - rwork = (double *) R_alloc((3*n-2) > 1 ? 3*n-2 : 1, sizeof(double)); - /* ask for optimal size of work array */ - lwork = -1; - F77_CALL(zheev)(jobv, uplo, &n, rx, &n, rvalues, &tmp, &lwork, rwork, - &info); + SPL_CALL(zheev)(jobv, 'L', n, rx, n, rvalues, &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "zheev"); - lwork = (int) tmp.r; - work = (Rcomplex *) R_alloc(lwork, sizeof(Rcomplex)); - F77_CALL(zheev)(jobv, uplo, &n, rx, &n, rvalues, work, &lwork, rwork, - &info); - if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "zheev"); if (!ov) { ret = PROTECT(allocVector(VECSXP, 2)); nm = PROTECT(allocVector(STRSXP, 2)); @@ -768,10 +648,9 @@ static SEXP modLa_rg_cmplx(SEXP x, SEXP only_values) { #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX - int n, lwork, info, *xdims, ov; - Rcomplex *work, *left, *right, *xvals, tmp; - double *rwork; - char jobVL[1], jobVR[1]; + int n, info, *xdims, ov; + Rcomplex *left, *right, *xvals; + char jobVR; SEXP ret, nm, values, val = R_NilValue; xdims = INTEGER(coerceVector(getAttrib(x, R_DimSymbol), INTSXP)); @@ -784,27 +663,18 @@ Memcpy(xvals, COMPLEX(x), n * n); ov = asLogical(only_values); if (ov == NA_LOGICAL) error(_("invalid '%s' argument"), "only.values"); - jobVL[0] = jobVR[0] = 'N'; + jobVR = 'N'; left = right = (Rcomplex *) 0; if (!ov) { - jobVR[0] = 'V'; + jobVR = 'V'; PROTECT(val = allocMatrix(CPLXSXP, n, n)); right = COMPLEX(val); } PROTECT(values = allocVector(CPLXSXP, n)); - rwork = (double *) R_alloc(2*n, sizeof(double)); - /* ask for optimal size of work array */ - lwork = -1; - F77_CALL(zgeev)(jobVL, jobVR, &n, xvals, &n, COMPLEX(values), - left, &n, right, &n, &tmp, &lwork, rwork, &info); + SPL_CALL(zgeev)('N', jobVR, n, xvals, n, COMPLEX(values), + left, n, right, n, &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "zgeev"); - lwork = (int) tmp.r; - work = (Rcomplex *) R_alloc(lwork, sizeof(Rcomplex)); - F77_CALL(zgeev)(jobVL, jobVR, &n, xvals, &n, COMPLEX(values), - left, &n, right, &n, work, &lwork, rwork, &info); - if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "zgeev"); if(!ov){ ret = PROTECT(allocVector(VECSXP, 2)); @@ -846,7 +716,7 @@ } } - F77_CALL(dpotrf)("Upper", &m, REAL(ans), &m, &i); + SPL_CALL(dpotrf)('U', m, REAL(ans), m, &i); if (i != 0) { if (i > 0) error(_("the leading minor of order %d is not positive definite"), @@ -887,7 +757,7 @@ for (i = 0; i <= j; i++) REAL(ans)[i + j * sz] = REAL(Amat)[i + j * m]; } - F77_CALL(dpotri)("Upper", &sz, REAL(ans), &sz, &i); + SPL_CALL(dpotri)('U', sz, REAL(ans), sz, &i); if (i != 0) { UNPROTECT(nprot); if (i > 0) @@ -910,7 +780,7 @@ static SEXP modLa_dgesv(SEXP A, SEXP Bin, SEXP tolin) { int n, p, info, *ipiv, *Adims, *Bdims; - double *avals, anorm, rcond, tol = asReal(tolin), *work; + double *avals, anorm, rcond, tol = asReal(tolin); SEXP B; if (!(isMatrix(A) && isReal(A))) @@ -930,19 +800,18 @@ error(_("'b' (%d x %d) must be compatible with 'a' (%d x %d)"), Bdims[0], p, n, n); ipiv = (int *) R_alloc(n, sizeof(int)); - avals = (double *) R_alloc(n * n, sizeof(double)); /* work on a copy of A */ Memcpy(avals, REAL(A), n * n); - F77_CALL(dgesv)(&n, &p, avals, &n, ipiv, REAL(B), &n, &info); + SPL_CALL(dgesv)(n, p, avals, n, ipiv, REAL(B), n, &info); if (info < 0) error(_("argument %d of Lapack routine %s had invalid value"), -info, "dgesv"); if (info > 0) error(_("Lapack routine dgesv: system is exactly singular")); + /* hopefully compatible to sunperf */ anorm = F77_CALL(dlange)("1", &n, &n, REAL(A), &n, (double*) NULL); - work = (double *) R_alloc(4*n, sizeof(double)); - F77_CALL(dgecon)("1", &n, avals, &n, &anorm, &rcond, work, ipiv, &info); + SPL_CALL(dgecon)('1', n, avals, n, anorm, &rcond, &info); if (rcond < tol) error(_("system is computationally singular: reciprocal condition number = %g"), rcond); @@ -952,8 +821,7 @@ static SEXP modLa_dgeqp3(SEXP Ain) { - int i, m, n, *Adims, info, lwork; - double *work, tmp; + int i, m, n, *Adims, info; SEXP val, nm, jpvt, tau, rank, A; if (!(isMatrix(Ain) && isReal(Ain))) @@ -966,17 +834,9 @@ jpvt = PROTECT(allocVector(INTSXP, n)); for (i = 0; i < n; i++) INTEGER(jpvt)[i] = 0; tau = PROTECT(allocVector(REALSXP, m < n ? m : n)); - lwork = -1; - F77_CALL(dgeqp3)(&m, &n, REAL(A), &m, INTEGER(jpvt), REAL(tau), - &tmp, &lwork, &info); + SPL_CALL(dgeqp3)(m, n, REAL(A), m, INTEGER(jpvt), REAL(tau), &info); if (info < 0) error(_("error code %d from Lapack routine '%s'"), info, "dgeqp3"); - lwork = (int) tmp; - work = (double *) R_alloc(lwork, sizeof(double)); - F77_CALL(dgeqp3)(&m, &n, REAL(A), &m, INTEGER(jpvt), REAL(tau), - work, &lwork, &info); - if (info < 0) - error(_("error code %d from Lapack routine '%s'"), info, "dgeqp3"); val = PROTECT(allocVector(VECSXP, 4)); nm = PROTECT(allocVector(STRSXP, 4)); rank = PROTECT(ScalarInteger(m < n ? m : n)); @@ -995,9 +855,8 @@ static SEXP modqr_coef_real(SEXP Q, SEXP Bin) { - int n, nrhs, lwork, info, k, *Bdims, *Qdims; + int n, nrhs, info, k, *Bdims, *Qdims; SEXP B, qr=VECTOR_ELT(Q, 0), tau=VECTOR_ELT(Q, 2); - double *work, tmp; k = LENGTH(tau); if (!(isMatrix(Bin) && isReal(Bin))) @@ -1010,22 +869,13 @@ if(Bdims[0] != n) error(_("right-hand side should have %d not %d rows"), n, Bdims[0]); nrhs = Bdims[1]; - lwork = -1; - F77_CALL(dormqr)("L", "T", &n, &nrhs, &k, - REAL(qr), &n, REAL(tau), REAL(B), &n, - &tmp, &lwork, &info); + SPL_CALL(dormqr)('L', 'T', n, nrhs, k, + REAL(qr), n, REAL(tau), REAL(B), n, &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "dormqr"); - lwork = (int) tmp; - work = (double *) R_alloc(lwork, sizeof(double)); - F77_CALL(dormqr)("L", "T", &n, &nrhs, &k, - REAL(qr), &n, REAL(tau), REAL(B), &n, - work, &lwork, &info); + SPL_CALL(dtrtrs)('U', 'N', 'N', k, nrhs, + REAL(qr), n, REAL(B), n, &info); if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "dormqr"); - F77_CALL(dtrtrs)("U", "N", "N", &k, &nrhs, - REAL(qr), &n, REAL(B), &n, &info); - if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "dtrtrs"); UNPROTECT(1); return B; @@ -1033,9 +883,8 @@ static SEXP modqr_qy_real(SEXP Q, SEXP Bin, SEXP trans) { - int n, nrhs, lwork, info, k, *Bdims, *Qdims, tr; + int n, nrhs, info, k, *Bdims, *Qdims, tr; SEXP B, qr=VECTOR_ELT(Q, 0), tau=VECTOR_ELT(Q, 2); - double *work, tmp; k = LENGTH(tau); if (!(isMatrix(Bin) && isReal(Bin))) @@ -1050,19 +899,10 @@ if(Bdims[0] != n) error(_("right-hand side should have %d not %d rows"), n, Bdims[0]); nrhs = Bdims[1]; - lwork = -1; - F77_CALL(dormqr)("L", tr ? "T" : "N", &n, &nrhs, &k, - REAL(qr), &n, REAL(tau), REAL(B), &n, - &tmp, &lwork, &info); + SPL_CALL(dormqr)('L', tr ? 'T' : 'N', n, nrhs, k, + REAL(qr), n, REAL(tau), REAL(B), n, &info); if (info != 0) error(_("error code %d from Lapack routine '%s'"), info, "dormqr"); - lwork = (int) tmp; - work = (double *) R_alloc(lwork, sizeof(double)); - F77_CALL(dormqr)("L", tr ? "T" : "N", &n, &nrhs, &k, - REAL(qr), &n, REAL(tau), REAL(B), &n, - work, &lwork, &info); - if (info != 0) - error(_("error code %d from Lapack routine '%s'"), info, "dormqr"); UNPROTECT(1); return B; } @@ -1083,7 +923,7 @@ if (Adims[1] != n) error(_("'a' must be a square matrix")); jpvt = (int *) R_alloc(n, sizeof(int)); - F77_CALL(dgetrf)(&n, &n, REAL(A), &n, jpvt, &info); + SPL_CALL(dgetrf)(n, n, REAL(A), n, jpvt, &info); sign = 1; if (info < 0) error(_("error code %d from Lapack routine '%s'"), info, "dgetrf");