diff --git a/lapack-netlib/SRC/DEPRECATED/cgegs.c b/lapack-netlib/SRC/DEPRECATED/cgegs.c index 4770bb21cb..bc4dc697e5 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/cgegs.c @@ -538,7 +538,7 @@ rices */ *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *); real safmin; - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); real bignum; @@ -633,21 +633,18 @@ rices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvsl < 1 || ilvsl && *ldvsl < *n) { + } else if (*ldvsl < 1 || (ilvsl && *ldvsl < *n)) { *info = -11; - } else if (*ldvsr < 1 || ilvsr && *ldvsr < *n) { + } else if (*ldvsr < 1 || (ilvsr && *ldvsr < *n)) { *info = -13; } else if (*lwork < lwkmin && ! lquery) { *info = -15; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "CGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "CUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "CUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "CGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "CUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "CUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -657,7 +654,7 @@ rices */ if (*info != 0) { i__1 = -(*info); - xerbla_("CGEGS ", &i__1, 6); + xerbla_("CGEGS ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/cgegv.c b/lapack-netlib/SRC/DEPRECATED/cgegv.c index 482a6633d7..2599c3b30c 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/cgegv.c @@ -610,7 +610,7 @@ rices */ integer *, integer *, complex *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); integer ijobvl, iright; @@ -701,21 +701,18 @@ rices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvl < 1 || ilvl && *ldvl < *n) { + } else if (*ldvl < 1 || (ilvl && *ldvl < *n)) { *info = -11; - } else if (*ldvr < 1 || ilvr && *ldvr < *n) { + } else if (*ldvr < 1 || (ilvr && *ldvr < *n)) { *info = -13; } else if (*lwork < lwkmin && ! lquery) { *info = -15; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "CGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "CUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "CUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "CGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "CUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "CUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -727,7 +724,7 @@ rices */ if (*info != 0) { i__1 = -(*info); - xerbla_("CGEGV ", &i__1, 6); + xerbla_("CGEGV ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/cgelqs.c b/lapack-netlib/SRC/DEPRECATED/cgelqs.c index 3b71b83660..a5ce47bfc3 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/cgelqs.c @@ -380,7 +380,7 @@ static complex c_b2 = {1.f,0.f}; /* > \ingroup complex_lin */ /* ===================================================================== */ -/* Subroutine */ int cgelqs_(integer *m, integer *n, integer *nrhs, complex * +/* Subroutine */ void cgelqs_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, complex *tau, complex *b, integer *ldb, complex * work, integer *lwork, integer *info) { @@ -388,10 +388,11 @@ static complex c_b2 = {1.f,0.f}; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, + extern /* Subroutine */ void ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), claset_(char *, - integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), cunmlq_(char *, char + integer *, integer *, complex *, complex *, complex *, integer *), + xerbla_(char *, integer *, ftnlen), cunmlq_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -428,19 +429,19 @@ static complex c_b2 = {1.f,0.f}; *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQS", &i__1); - return 0; + xerbla_("CGELQS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* Solve L*X = B(1:m,:) */ @@ -460,7 +461,7 @@ static complex c_b2 = {1.f,0.f}; cunmlq_("Left", "Conjugate transpose", n, nrhs, m, &a[a_offset], lda, & tau[1], &b[b_offset], ldb, &work[1], lwork, info); - return 0; + return; /* End of CGELQS */ diff --git a/lapack-netlib/SRC/DEPRECATED/cgelsx.c b/lapack-netlib/SRC/DEPRECATED/cgelsx.c index ae4bcd0c31..5e69969c00 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/cgelsx.c @@ -485,7 +485,7 @@ f"> */ extern real slamch_(char *); extern /* Subroutine */ void claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); real bignum; extern /* Subroutine */ void clatzm_(char *, integer *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex @@ -542,7 +542,7 @@ f"> */ if (*info != 0) { i__1 = -(*info); - xerbla_("CGELSX", &i__1, 6); + xerbla_("CGELSX", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/cgeqpf.c b/lapack-netlib/SRC/DEPRECATED/cgeqpf.c index f27fece7be..46305a15b1 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/cgeqpf.c @@ -444,7 +444,7 @@ f"> */ extern /* Subroutine */ void clarfg_(integer *, complex *, complex *, integer *, complex *); extern real slamch_(char *); - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); extern integer isamax_(integer *, real *, integer *); complex aii; integer pvt; @@ -481,7 +481,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQPF", &i__1, 6); + xerbla_("CGEQPF", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/cgeqrs.c b/lapack-netlib/SRC/DEPRECATED/cgeqrs.c index 882eee9468..50a1e20e5b 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/cgeqrs.c @@ -378,7 +378,7 @@ static complex c_b1 = {1.f,0.f}; /* > \ingroup complex_lin */ /* ===================================================================== */ -/* Subroutine */ int cgeqrs_(integer *m, integer *n, integer *nrhs, complex * +/* Subroutine */ void cgeqrs_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, complex *tau, complex *b, integer *ldb, complex * work, integer *lwork, integer *info) { @@ -386,10 +386,10 @@ static complex c_b1 = {1.f,0.f}; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, + extern /* Subroutine */ void ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, - integer *), cunmqr_(char *, char *, integer *, integer *, + integer *, ftnlen), cunmqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -426,19 +426,19 @@ static complex c_b1 = {1.f,0.f}; *info = -5; } else if (*ldb < f2cmax(1,*m)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRS", &i__1); - return 0; + xerbla_("CGEQRS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* B := Q' * B */ @@ -451,7 +451,7 @@ static complex c_b1 = {1.f,0.f}; ctrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b1, &a[ a_offset], lda, &b[b_offset], ldb); - return 0; + return; /* End of CGEQRS */ diff --git a/lapack-netlib/SRC/DEPRECATED/cggsvd.c b/lapack-netlib/SRC/DEPRECATED/cggsvd.c index 4f0c6f5882..0e437f6df4 100644 --- a/lapack-netlib/SRC/DEPRECATED/cggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/cggsvd.c @@ -637,7 +637,7 @@ f"> */ complex *, integer *, real *, real *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void cggsvp_(char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, integer *, integer *, complex *, integer *, @@ -701,16 +701,16 @@ f"> */ *info = -10; } else if (*ldb < f2cmax(1,*p)) { *info = -12; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("CGGSVD", &i__1, 6); + xerbla_("CGGSVD", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/cggsvp.c b/lapack-netlib/SRC/DEPRECATED/cggsvp.c index 047d9b3218..695152b04d 100644 --- a/lapack-netlib/SRC/DEPRECATED/cggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/cggsvp.c @@ -561,7 +561,7 @@ f"> */ *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void clapmt_(logical *, integer *, integer *, complex *, integer *, integer *); logical forwrd; @@ -622,16 +622,16 @@ f"> */ *info = -8; } else if (*ldb < f2cmax(1,*p)) { *info = -10; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("CGGSVP", &i__1, 6); + xerbla_("CGGSVP", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/clatzm.c b/lapack-netlib/SRC/DEPRECATED/clatzm.c index e721ba9022..8fad12932e 100644 --- a/lapack-netlib/SRC/DEPRECATED/clatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/clatzm.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} diff --git a/lapack-netlib/SRC/DEPRECATED/ctzrqf.c b/lapack-netlib/SRC/DEPRECATED/ctzrqf.c index 045222f546..d114513d75 100644 --- a/lapack-netlib/SRC/DEPRECATED/ctzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/ctzrqf.c @@ -422,7 +422,7 @@ f"> */ integer m1; extern /* Subroutine */ void clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -453,7 +453,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("CTZRQF", &i__1, 6); + xerbla_("CTZRQF", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/dgegs.c b/lapack-netlib/SRC/DEPRECATED/dgegs.c index 7d7b5e6462..e8d99c97e0 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/dgegs.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -543,7 +506,7 @@ rices */ doublereal safmin; extern /* Subroutine */ void dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); doublereal bignum; @@ -640,21 +603,18 @@ rices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvsl < 1 || ilvsl && *ldvsl < *n) { + } else if (*ldvsl < 1 || (ilvsl && *ldvsl < *n)) { *info = -12; - } else if (*ldvsr < 1 || ilvsr && *ldvsr < *n) { + } else if (*ldvsr < 1 || (ilvsr && *ldvsr < *n)) { *info = -14; } else if (*lwork < lwkmin && ! lquery) { *info = -16; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "DGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "DORMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "DORGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "DGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "DORMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "DORGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -664,7 +624,7 @@ rices */ if (*info != 0) { i__1 = -(*info); - xerbla_("DGEGS ", &i__1, 6); + xerbla_("DGEGS ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/dgegv.c b/lapack-netlib/SRC/DEPRECATED/dgegv.c index 72a146405c..bfaf1bee44 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/dgegv.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -636,7 +599,7 @@ rices */ logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); integer ijobvl, iright; logical ilimit; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, @@ -729,21 +692,18 @@ rices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvl < 1 || ilvl && *ldvl < *n) { + } else if (*ldvl < 1 || (ilvl && *ldvl < *n)) { *info = -12; - } else if (*ldvr < 1 || ilvr && *ldvr < *n) { + } else if (*ldvr < 1 || (ilvr && *ldvr < *n)) { *info = -14; } else if (*lwork < lwkmin && ! lquery) { *info = -16; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "DGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "DORMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "DORGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "DGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "DORMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "DORGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -755,7 +715,7 @@ rices */ if (*info != 0) { i__1 = -(*info); - xerbla_("DGEGV ", &i__1, 6); + xerbla_("DGEGV ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/dgelqs.c b/lapack-netlib/SRC/DEPRECATED/dgelqs.c index df0c351b3c..c8ee29eb82 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/dgelqs.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle_() continue; #define myceiling_(w) {ceil(w)} @@ -379,7 +342,7 @@ static doublereal c_b9 = 0.; /* > \ingroup double_lin */ /* ===================================================================== */ -/* Subroutine */ int dgelqs_(integer *m, integer *n, integer *nrhs, +/* Subroutine */ void dgelqs_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *tau, doublereal *b, integer * ldb, doublereal *work, integer *lwork, integer *info) { @@ -387,11 +350,12 @@ static doublereal c_b9 = 0.; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *, + extern /* Subroutine */ void dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlaset_( char *, integer *, integer *, doublereal *, doublereal *, - doublereal *, integer *), xerbla_(char *, integer *), dormlq_(char *, char *, integer *, integer *, integer *, + doublereal *, integer *), xerbla_(char *, integer *, ftnlen), + dormlq_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -428,19 +392,19 @@ static doublereal c_b9 = 0.; *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQS", &i__1); - return 0; + xerbla_("DGELQS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* Solve L*X = B(1:m,:) */ @@ -460,7 +424,7 @@ static doublereal c_b9 = 0.; dormlq_("Left", "Transpose", n, nrhs, m, &a[a_offset], lda, &tau[1], &b[ b_offset], ldb, &work[1], lwork, info); - return 0; + return; /* End of DGELQS */ diff --git a/lapack-netlib/SRC/DEPRECATED/dgelsx.c b/lapack-netlib/SRC/DEPRECATED/dgelsx.c index 5871f75013..9d89404a6f 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/dgelsx.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -481,7 +444,7 @@ f"> */ doublereal *, integer *, integer *, doublereal *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); doublereal bignum; extern /* Subroutine */ void dlatzm_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, @@ -536,7 +499,7 @@ f"> */ if (*info != 0) { i__1 = -(*info); - xerbla_("DGELSX", &i__1, 6); + xerbla_("DGELSX", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/dgeqpf.c b/lapack-netlib/SRC/DEPRECATED/dgeqpf.c index e23f53a6ab..7e1351f381 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/dgeqpf.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -440,7 +403,7 @@ f"> */ extern /* Subroutine */ void dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); extern integer idamax_(integer *, doublereal *, integer *); - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); doublereal aii; integer pvt; @@ -475,7 +438,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQPF", &i__1, 6); + xerbla_("DGEQPF", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/dgeqrs.c b/lapack-netlib/SRC/DEPRECATED/dgeqrs.c index f94e69d8f7..a455117d03 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/dgeqrs.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle_() continue; #define myceiling_(w) {ceil(w)} @@ -378,7 +341,7 @@ static doublereal c_b9 = 1.; /* > \ingroup double_lin */ /* ===================================================================== */ -/* Subroutine */ int dgeqrs_(integer *m, integer *n, integer *nrhs, +/* Subroutine */ void dgeqrs_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *tau, doublereal *b, integer * ldb, doublereal *work, integer *lwork, integer *info) { @@ -386,10 +349,10 @@ static doublereal c_b9 = 1.; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *, + extern /* Subroutine */ void dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( - char *, integer *), dormqr_(char *, char *, integer *, + char *, integer *, ftnlen), dormqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -426,19 +389,19 @@ static doublereal c_b9 = 1.; *info = -5; } else if (*ldb < f2cmax(1,*m)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRS", &i__1); - return 0; + xerbla_("DGEQRS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* B := Q' * B */ @@ -451,7 +414,7 @@ static doublereal c_b9 = 1.; dtrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b9, &a[ a_offset], lda, &b[b_offset], ldb); - return 0; + return; /* End of DGEQRS */ diff --git a/lapack-netlib/SRC/DEPRECATED/dggsvd.c b/lapack-netlib/SRC/DEPRECATED/dggsvd.c index fddc72cbda..0f90e6ff60 100644 --- a/lapack-netlib/SRC/DEPRECATED/dggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/dggsvd.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -634,7 +597,7 @@ f"> */ doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void dggsvp_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, @@ -697,16 +660,16 @@ f"> */ *info = -10; } else if (*ldb < f2cmax(1,*p)) { *info = -12; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("DGGSVD", &i__1, 6); + xerbla_("DGGSVD", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/dggsvp.c b/lapack-netlib/SRC/DEPRECATED/dggsvp.c index 66cf0f39c1..983a2a1bb8 100644 --- a/lapack-netlib/SRC/DEPRECATED/dggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/dggsvp.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -556,7 +519,7 @@ f"> */ dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); logical forwrd; @@ -616,16 +579,16 @@ f"> */ *info = -8; } else if (*ldb < f2cmax(1,*p)) { *info = -10; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("DGGSVP", &i__1, 6); + xerbla_("DGGSVP", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/dlahrd.c b/lapack-netlib/SRC/DEPRECATED/dlahrd.c index 0e960aaf21..3830c92005 100644 --- a/lapack-netlib/SRC/DEPRECATED/dlahrd.c +++ b/lapack-netlib/SRC/DEPRECATED/dlahrd.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} diff --git a/lapack-netlib/SRC/DEPRECATED/dlatzm.c b/lapack-netlib/SRC/DEPRECATED/dlatzm.c index c2954c4b7b..af016fe7c6 100644 --- a/lapack-netlib/SRC/DEPRECATED/dlatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/dlatzm.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} diff --git a/lapack-netlib/SRC/DEPRECATED/dtzrqf.c b/lapack-netlib/SRC/DEPRECATED/dtzrqf.c index f919ce5f11..bb8c2518e8 100644 --- a/lapack-netlib/SRC/DEPRECATED/dtzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/dtzrqf.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -423,7 +386,7 @@ f"> */ integer m1; extern /* Subroutine */ void dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -454,7 +417,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("DTZRQF", &i__1, 6); + xerbla_("DTZRQF", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/sgegs.c b/lapack-netlib/SRC/DEPRECATED/sgegs.c index 05b5bb584d..c8528a620d 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/sgegs.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -531,7 +494,7 @@ ices */ extern /* Subroutine */ void sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); real bignum; @@ -634,21 +597,18 @@ ices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvsl < 1 || ilvsl && *ldvsl < *n) { + } else if (*ldvsl < 1 || (ilvsl && *ldvsl < *n)) { *info = -12; - } else if (*ldvsr < 1 || ilvsr && *ldvsr < *n) { + } else if (*ldvsr < 1 || (ilvsr && *ldvsr < *n)) { *info = -14; } else if (*lwork < lwkmin && ! lquery) { *info = -16; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "SGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "SORMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "SORGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "SGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "SORMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "SORGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -658,7 +618,7 @@ ices */ if (*info != 0) { i__1 = -(*info); - xerbla_("SGEGS ", &i__1, 6); + xerbla_("SGEGS ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/sgegv.c b/lapack-netlib/SRC/DEPRECATED/sgegv.c index 575feefbcc..895c71469e 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/sgegv.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -617,7 +580,7 @@ rices */ logical ldumma[1]; extern /* Subroutine */ void slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); integer ijobvl, iright; @@ -721,21 +684,18 @@ rices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvl < 1 || ilvl && *ldvl < *n) { + } else if (*ldvl < 1 || (ilvl && *ldvl < *n)) { *info = -12; - } else if (*ldvr < 1 || ilvr && *ldvr < *n) { + } else if (*ldvr < 1 || (ilvr && *ldvr < *n)) { *info = -14; } else if (*lwork < lwkmin && ! lquery) { *info = -16; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "SGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "SORMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "SORGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "SGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "SORMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "SORGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -747,7 +707,7 @@ rices */ if (*info != 0) { i__1 = -(*info); - xerbla_("SGEGV ", &i__1, 6); + xerbla_("SGEGV ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/sgelqs.c b/lapack-netlib/SRC/DEPRECATED/sgelqs.c index c0b9dc8cdd..d9653b6f96 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/sgelqs.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle_() continue; #define myceiling_(w) {ceil(w)} @@ -374,7 +337,7 @@ static real c_b9 = 0.f; /* > \ingroup single_lin */ /* ===================================================================== */ -/* Subroutine */ int sgelqs_(integer *m, integer *n, integer *nrhs, real *a, +/* Subroutine */ void sgelqs_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real *tau, real *b, integer *ldb, real *work, integer * lwork, integer *info) { @@ -382,9 +345,9 @@ static real c_b9 = 0.f; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int strsm_(char *, char *, char *, char *, + extern /* Subroutine */ void strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * - ), xerbla_(char *, integer *), slaset_(char *, integer *, integer *, real *, real *, + ), xerbla_(char *, integer *, ftnlen), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), sormlq_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer * , real *, integer *, integer *); @@ -422,19 +385,19 @@ static real c_b9 = 0.f; *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQS", &i__1); - return 0; + xerbla_("SGELQS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* Solve L*X = B(1:m,:) */ @@ -454,7 +417,7 @@ static real c_b9 = 0.f; sormlq_("Left", "Transpose", n, nrhs, m, &a[a_offset], lda, &tau[1], &b[ b_offset], ldb, &work[1], lwork, info); - return 0; + return; /* End of SGELQS */ diff --git a/lapack-netlib/SRC/DEPRECATED/sgelsx.c b/lapack-netlib/SRC/DEPRECATED/sgelsx.c index c91c746b22..40e7a1ce9d 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/sgelsx.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -471,7 +434,7 @@ f"> */ integer mn; extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); real bignum; extern /* Subroutine */ void slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), sgeqpf_(integer *, integer *, real *, integer *, integer @@ -529,7 +492,7 @@ f"> */ if (*info != 0) { i__1 = -(*info); - xerbla_("SGELSX", &i__1, 6); + xerbla_("SGELSX", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/sgeqpf.c b/lapack-netlib/SRC/DEPRECATED/sgeqpf.c index d2889e44aa..8d58cefaaa 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/sgeqpf.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -435,7 +398,7 @@ f"> */ integer *); integer mn; extern real slamch_(char *); - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); extern void slarfg_( integer *, real *, real *, integer *, real *); extern integer isamax_(integer *, real *, integer *); @@ -473,7 +436,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQPF", &i__1, 6); + xerbla_("SGEQPF", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/sgeqrs.c b/lapack-netlib/SRC/DEPRECATED/sgeqrs.c index 1530337f5e..0f2c6a8486 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/sgeqrs.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle_() continue; #define myceiling_(w) {ceil(w)} @@ -378,7 +341,7 @@ static real c_b9 = 1.f; /* > \ingroup single_lin */ /* ===================================================================== */ -/* Subroutine */ int sgeqrs_(integer *m, integer *n, integer *nrhs, real *a, +/* Subroutine */ void sgeqrs_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real *tau, real *b, integer *ldb, real *work, integer * lwork, integer *info) { @@ -386,9 +349,9 @@ static real c_b9 = 1.f; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int strsm_(char *, char *, char *, char *, + extern /* Subroutine */ void strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * - ), xerbla_(char *, integer *), sormqr_(char *, char *, integer *, integer *, integer *, + ), xerbla_(char *, integer *, ftnlen), sormqr_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *); @@ -425,19 +388,19 @@ static real c_b9 = 1.f; *info = -5; } else if (*ldb < f2cmax(1,*m)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRS", &i__1); - return 0; + xerbla_("SGEQRS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* B := Q' * B */ @@ -450,7 +413,7 @@ static real c_b9 = 1.f; strsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b9, &a[ a_offset], lda, &b[b_offset], ldb); - return 0; + return; /* End of SGEQRS */ diff --git a/lapack-netlib/SRC/DEPRECATED/sggsvd.c b/lapack-netlib/SRC/DEPRECATED/sggsvd.c index 39f60e5475..0d17dbbbaf 100644 --- a/lapack-netlib/SRC/DEPRECATED/sggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/sggsvd.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -628,7 +591,7 @@ f"> */ logical wantu, wantv; extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); extern void stgsja_( char *, char *, char *, integer *, integer *, integer *, integer * , integer *, real *, integer *, real *, integer *, real *, real *, @@ -695,16 +658,16 @@ f"> */ *info = -10; } else if (*ldb < f2cmax(1,*p)) { *info = -12; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("SGGSVD", &i__1, 6); + xerbla_("SGGSVD", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/sggsvp.c b/lapack-netlib/SRC/DEPRECATED/sggsvp.c index 2626170c57..566366a68a 100644 --- a/lapack-netlib/SRC/DEPRECATED/sggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/sggsvp.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -548,7 +511,7 @@ f"> */ ), sorm2r_(char *, char *, integer *, integer *, integer *, real * , integer *, real *, real *, integer *, real *, integer *), sormr2_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void sgeqpf_( integer *, integer *, real *, integer *, integer *, real *, real * , integer *), slacpy_(char *, integer *, integer *, real *, @@ -612,16 +575,16 @@ f"> */ *info = -8; } else if (*ldb < f2cmax(1,*p)) { *info = -10; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("SGGSVP", &i__1, 6); + xerbla_("SGGSVP", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/slahrd.c b/lapack-netlib/SRC/DEPRECATED/slahrd.c index 518d6cc4e2..ccb4fd272f 100644 --- a/lapack-netlib/SRC/DEPRECATED/slahrd.c +++ b/lapack-netlib/SRC/DEPRECATED/slahrd.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} diff --git a/lapack-netlib/SRC/DEPRECATED/slatzm.c b/lapack-netlib/SRC/DEPRECATED/slatzm.c index 7b84a5d3bb..757ed1cc30 100644 --- a/lapack-netlib/SRC/DEPRECATED/slatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/slatzm.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} diff --git a/lapack-netlib/SRC/DEPRECATED/stzrqf.c b/lapack-netlib/SRC/DEPRECATED/stzrqf.c index 61773343d0..310295038b 100644 --- a/lapack-netlib/SRC/DEPRECATED/stzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/stzrqf.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -417,7 +380,7 @@ f"> */ integer m1; extern /* Subroutine */ void saxpy_(integer *, real *, real *, integer *, real *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void slarfg_( integer *, real *, real *, integer *, real *); @@ -450,7 +413,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("STZRQF", &i__1, 6); + xerbla_("STZRQF", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/zgegs.c b/lapack-netlib/SRC/DEPRECATED/zgegs.c index 7f3b0ed62b..3977a8bdf7 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/zgegs.c @@ -526,7 +526,7 @@ rices */ , integer *, doublereal *, doublereal *, doublereal *, integer *); logical ilascl, ilbscl; doublereal safmin; - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, @@ -638,21 +638,18 @@ rices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvsl < 1 || ilvsl && *ldvsl < *n) { + } else if (*ldvsl < 1 || (ilvsl && *ldvsl < *n)) { *info = -11; - } else if (*ldvsr < 1 || ilvsr && *ldvsr < *n) { + } else if (*ldvsr < 1 || (ilvsr && *ldvsr < *n)) { *info = -13; } else if (*lwork < lwkmin && ! lquery) { *info = -15; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "ZGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "ZUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "ZUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "ZGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "ZUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "ZUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -662,7 +659,7 @@ rices */ if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEGS ", &i__1, 6); + xerbla_("ZGEGS ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/zgegv.c b/lapack-netlib/SRC/DEPRECATED/zgegv.c index 791362d1d9..bf37bfad61 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/zgegv.c @@ -587,7 +587,7 @@ rices */ doublecomplex *, integer *, doublecomplex *, integer *, integer * , integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal salfar, safmin; - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); doublereal safmax; char chtemp[1]; logical ldumma[1]; @@ -704,21 +704,18 @@ rices */ *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -7; - } else if (*ldvl < 1 || ilvl && *ldvl < *n) { + } else if (*ldvl < 1 || (ilvl && *ldvl < *n)) { *info = -11; - } else if (*ldvr < 1 || ilvr && *ldvr < *n) { + } else if (*ldvr < 1 || (ilvr && *ldvr < *n)) { *info = -13; } else if (*lwork < lwkmin && ! lquery) { *info = -15; } if (*info == 0) { - nb1 = ilaenv_(&c__1, "ZGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb2 = ilaenv_(&c__1, "ZUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); - nb3 = ilaenv_(&c__1, "ZUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, ( - ftnlen)1); + nb1 = ilaenv_(&c__1, "ZGEQRF", " ", n, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1); + nb2 = ilaenv_(&c__1, "ZUNMQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); + nb3 = ilaenv_(&c__1, "ZUNGQR", " ", n, n, n, &c_n1, (ftnlen)6, (ftnlen)1); /* Computing MAX */ i__1 = f2cmax(nb1,nb2); nb = f2cmax(i__1,nb3); @@ -730,7 +727,7 @@ rices */ if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEGV ", &i__1, 6); + xerbla_("ZGEGV ", &i__1, (ftnlen)6); return; } else if (lquery) { return; diff --git a/lapack-netlib/SRC/DEPRECATED/zgelqs.c b/lapack-netlib/SRC/DEPRECATED/zgelqs.c index 59d84d7c2b..6d06afeb00 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/zgelqs.c @@ -379,7 +379,7 @@ static doublecomplex c_b2 = {1.,0.}; /* > \ingroup complex16_lin */ /* ===================================================================== */ -/* Subroutine */ int zgelqs_(integer *m, integer *n, integer *nrhs, +/* Subroutine */ void zgelqs_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info) { @@ -387,10 +387,10 @@ static doublecomplex c_b2 = {1.,0.}; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int ztrsm_(char *, char *, char *, char *, + extern /* Subroutine */ void ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), - xerbla_(char *, integer *), zlaset_(char *, integer *, + xerbla_(char *, integer *, ftnlen), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zunmlq_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, @@ -429,19 +429,19 @@ static doublecomplex c_b2 = {1.,0.}; *info = -5; } else if (*ldb < f2cmax(1,*n)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQS", &i__1); - return 0; + xerbla_("ZGELQS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* Solve L*X = B(1:m,:) */ @@ -461,7 +461,7 @@ static doublecomplex c_b2 = {1.,0.}; zunmlq_("Left", "Conjugate transpose", n, nrhs, m, &a[a_offset], lda, & tau[1], &b[b_offset], ldb, &work[1], lwork, info); - return 0; + return; /* End of ZGELQS */ diff --git a/lapack-netlib/SRC/DEPRECATED/zgelsx.c b/lapack-netlib/SRC/DEPRECATED/zgelsx.c index 396a38f2a7..6597046219 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/zgelsx.c @@ -479,7 +479,7 @@ f"> */ extern /* Subroutine */ void zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -544,7 +544,7 @@ f"> */ if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELSX", &i__1, 6); + xerbla_("ZGELSX", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/zgeqpf.c b/lapack-netlib/SRC/DEPRECATED/zgeqpf.c index 3f884d6603..eeb16c597e 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/zgeqpf.c @@ -445,7 +445,7 @@ f"> */ integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern integer idamax_(integer *, doublereal *, integer *); - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); extern void zlarfg_( integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); @@ -484,7 +484,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQPF", &i__1, 6); + xerbla_("ZGEQPF", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/zgeqrs.c b/lapack-netlib/SRC/DEPRECATED/zgeqrs.c index da3dccf4f8..bbec58b6c2 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/zgeqrs.c @@ -378,7 +378,7 @@ static doublecomplex c_b1 = {1.,0.}; /* > \ingroup complex16_lin */ /* ===================================================================== */ -/* Subroutine */ int zgeqrs_(integer *m, integer *n, integer *nrhs, +/* Subroutine */ void zgeqrs_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info) { @@ -386,10 +386,10 @@ static doublecomplex c_b1 = {1.,0.}; integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int ztrsm_(char *, char *, char *, char *, + extern /* Subroutine */ void ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), - xerbla_(char *, integer *), zunmqr_(char *, char *, + xerbla_(char *, integer *, ftnlen), zunmqr_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -427,19 +427,19 @@ static doublecomplex c_b1 = {1.,0.}; *info = -5; } else if (*ldb < f2cmax(1,*m)) { *info = -8; - } else if (*lwork < 1 || *lwork < *nrhs && *m > 0 && *n > 0) { + } else if (*lwork < 1 || (*lwork < *nrhs && *m > 0 && *n > 0)) { *info = -10; } if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRS", &i__1); - return 0; + xerbla_("ZGEQRS", &i__1, (ftnlen)6); + return; } /* Quick return if possible */ if (*n == 0 || *nrhs == 0 || *m == 0) { - return 0; + return; } /* B := Q' * B */ @@ -452,7 +452,7 @@ static doublecomplex c_b1 = {1.,0.}; ztrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b1, &a[ a_offset], lda, &b[b_offset], ldb); - return 0; + return; /* End of ZGEQRS */ diff --git a/lapack-netlib/SRC/DEPRECATED/zggsvd.c b/lapack-netlib/SRC/DEPRECATED/zggsvd.c index 5d252edce4..6970662bf1 100644 --- a/lapack-netlib/SRC/DEPRECATED/zggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/zggsvd.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} @@ -630,7 +593,7 @@ f"> */ doublereal *, integer *); logical wantq, wantu, wantv; extern doublereal dlamch_(char *); - extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen); + extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ void ztgsja_(char *, char *, char *, integer *, @@ -703,16 +666,16 @@ f"> */ *info = -10; } else if (*ldb < f2cmax(1,*p)) { *info = -12; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGSVD", &i__1, 6); + xerbla_("ZGGSVD", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/zggsvp.c b/lapack-netlib/SRC/DEPRECATED/zggsvp.c index c5b7fc1bc5..93acd3c735 100644 --- a/lapack-netlib/SRC/DEPRECATED/zggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/zggsvp.c @@ -561,7 +561,7 @@ f"> */ doublecomplex *, integer *, doublecomplex *, integer *), zunmr2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void zgeqpf_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, doublereal *, integer *), zlacpy_(char *, @@ -628,16 +628,16 @@ f"> */ *info = -8; } else if (*ldb < f2cmax(1,*p)) { *info = -10; - } else if (*ldu < 1 || wantu && *ldu < *m) { + } else if (*ldu < 1 || (wantu && *ldu < *m)) { *info = -16; - } else if (*ldv < 1 || wantv && *ldv < *p) { + } else if (*ldv < 1 || (wantv && *ldv < *p)) { *info = -18; - } else if (*ldq < 1 || wantq && *ldq < *n) { + } else if (*ldq < 1 || (wantq && *ldq < *n)) { *info = -20; } if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGSVP", &i__1, 6); + xerbla_("ZGGSVP", &i__1, (ftnlen)6); return; } diff --git a/lapack-netlib/SRC/DEPRECATED/zlahrd.c b/lapack-netlib/SRC/DEPRECATED/zlahrd.c index b35355153f..c64547ac9f 100644 --- a/lapack-netlib/SRC/DEPRECATED/zlahrd.c +++ b/lapack-netlib/SRC/DEPRECATED/zlahrd.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef char integer1; #define TRUE_ (1) @@ -184,33 +171,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -236,17 +205,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} diff --git a/lapack-netlib/SRC/DEPRECATED/zlatzm.c b/lapack-netlib/SRC/DEPRECATED/zlatzm.c index f7f67b0dbb..07958230d7 100644 --- a/lapack-netlib/SRC/DEPRECATED/zlatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/zlatzm.c @@ -39,19 +39,6 @@ typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; -#ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} -static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} -static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} -#else -static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} -static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} -#endif -#define pCf(z) (*_pCf(z)) -#define pCd(z) (*_pCd(z)) typedef blasint logical; typedef char logical1; @@ -187,33 +174,15 @@ typedef struct Namelist Namelist; #define bit_set(a,b) ((a) | ((uinteger)1 << (b))) #define abort_() { sig_die("Fortran abort routine called", 1); } -#define c_abs(z) (cabsf(Cf(z))) -#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } -#ifdef _MSC_VER -#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} -#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);} -#else -#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} -#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} -#endif -#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} -#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} -#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} -//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} -#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} #define d_abs(x) (fabs(*(x))) #define d_acos(x) (acos(*(x))) #define d_asin(x) (asin(*(x))) #define d_atan(x) (atan(*(x))) #define d_atn2(x, y) (atan2(*(x),*(y))) -#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } -#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } #define d_cos(x) (cos(*(x))) #define d_cosh(x) (cosh(*(x))) #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) #define d_exp(x) (exp(*(x))) -#define d_imag(z) (cimag(Cd(z))) -#define r_imag(z) (cimagf(Cf(z))) #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) @@ -239,17 +208,11 @@ typedef struct Namelist Namelist; #define pow_si(B,E) spow_ui(*(B),*(E)) #define pow_ri(B,E) spow_ui(*(B),*(E)) #define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -#define z_abs(z) (cabs(Cd(z))) -#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} -#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} #define myexit_() break; #define mycycle() continue; #define myceiling(w) {ceil(w)} diff --git a/lapack-netlib/SRC/DEPRECATED/ztzrqf.c b/lapack-netlib/SRC/DEPRECATED/ztzrqf.c index 54ec15c1eb..11010495b9 100644 --- a/lapack-netlib/SRC/DEPRECATED/ztzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/ztzrqf.c @@ -420,7 +420,7 @@ f"> */ extern /* Subroutine */ void zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); - extern int xerbla_(char *, integer *, ftnlen); + extern void xerbla_(char *, integer *, ftnlen); extern void zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); @@ -454,7 +454,7 @@ f"> */ } if (*info != 0) { i__1 = -(*info); - xerbla_("ZTZRQF", &i__1, 6); + xerbla_("ZTZRQF", &i__1, (ftnlen)6); return; }