/* dopla.f -- translated by f2c (version of 20 August 1993 13:15:44).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "f2c.h"
#ifndef min
# define min(a,b) ((a) <= (b) ? (a) : (b))
#endif
#ifndef max
# define max(a,b) ((a) >= (b) ? (a) : (b))
#endif
/* From http://www.netlib.org/templates/double/F2CLIBS/libF77/s_copy.c */
/* assign strings: a = b */
static void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
{
register char *aend, *bend;
aend = a + la;
if(la <= lb)
while(a < aend)
*a++ = *b++;
else
{
bend = b + lb;
while(b < bend)
*a++ = *b++;
while(a < aend)
*a++ = ' ';
}
}
/* Table of constant values */
static integer c__2 = 2;
static integer c__3 = 3;
doublereal dopla_(subnam, m, n, kl, ku, nb, subnam_len)
char *subnam;
integer *m, *n, *kl, *ku, *nb;
ftnlen subnam_len;
{
/* System generated locals */
integer i__1, i__2, i__3, i__4;
doublereal ret_val;
/* Builtin functions */
/* Subroutine int s_copy(); */
/* Local variables */
static doublereal adds;
static logical sord, corz;
static integer i;
extern logical lsame_();
static char c1[1], c2[2], c3[3];
static doublereal mults, addfac, ek, em, en, wl, mulfac, wu;
extern logical lsamen_();
static doublereal emn;
/* -- LAPACK timing routine (version 1.1b) -- */
/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
/* Courant Institute, Argonne National Lab, and Rice University */
/* February 29, 1992 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DOPLA computes an approximation of the number of floating point */
/* operations used by the subroutine SUBNAM with the given values */
/* of the parameters M, N, KL, KU, and NB. */
/* This version counts operations for the LAPACK subroutines. */
/* Arguments */
/* ========= */
/* SUBNAM (input) CHARACTER*6 */
/* The name of the subroutine. */
/* M (input) INTEGER */
/* The number of rows of the coefficient matrix. M >= 0. */
/* N (input) INTEGER */
/* The number of columns of the coefficient matrix. */
/* For solve routine when the matrix is square, */
/* N is the number of right hand sides. N >= 0. */
/* KL (input) INTEGER */
/* The lower band width of the coefficient matrix. */
/* If needed, 0 <= KL <= M-1. */
/* For xGEQRS, KL is the number of right hand sides. */
/* KU (input) INTEGER */
/* The upper band width of the coefficient matrix. */
/* If needed, 0 <= KU <= N-1. */
/* NB (input) INTEGER */
/* The block size. If needed, NB >= 1. */
/* Notes */
/* ===== */
/* In the comments below, the association is given between arguments */
/* in the requested subroutine and local arguments. For example, */
/* xGETRS: N, NRHS => M, N */
/* means that arguments N and NRHS in DGETRS are passed to arguments */
/* M and N in this procedure. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* -------------------------------------------------------- */
/* Initialize DOPLA to 0 and do a quick return if possible. */
/* -------------------------------------------------------- */
ret_val = 0.;
mults = 0.;
adds = 0.;
*c1 = *subnam;
s_copy(c2, subnam + 1, 2L, 2L);
s_copy(c3, subnam + 3, 3L, 3L);
sord = lsame_(c1, "S", 1L, 1L) || lsame_(c1, "D", 1L, 1L);
corz = lsame_(c1, "C", 1L, 1L) || lsame_(c1, "Z", 1L, 1L);
if (*m <= 0 || ! (sord || corz)) {
return ret_val;
}
/* --------------------------------------------------------- */
/* If the coefficient matrix is real, count each add as 1 */
/* operation and each multiply as 1 operation. */
/* If the coefficient matrix is complex, count each add as 2 */
/* operations and each multiply as 6 operations. */
/* --------------------------------------------------------- */
if (lsame_(c1, "S", 1L, 1L) || lsame_(c1, "D", 1L, 1L)) {
addfac = 1.;
mulfac = 1.;
} else {
addfac = 2.;
mulfac = 6.;
}
em = (doublereal) (*m);
en = (doublereal) (*n);
ek = (doublereal) (*kl);
/* --------------------------------- */
/* GE: GEneral rectangular matrices */
/* --------------------------------- */
if (lsamen_(&c__2, c2, "GE", 2L, 2L)) {
/* xGETRF: M, N => M, N */
if (lsamen_(&c__3, c3, "TRF", 3L, 3L)) {
emn = (doublereal) min(*m,*n);
adds = emn * (em * en - (em + en) * (emn + 1.) / 2. + (emn + 1.) *
(emn * 2. + 1.) / 6.);
mults = adds + emn * (em - (emn + 1.) / 2.);
/* xGETRS: N, NRHS => M, N */
} else if (lsamen_(&c__3, c3, "TRS", 3L, 3L)) {
mults = en * em * em;
adds = en * (em * (em - 1.));
/* xGETRI: N => M */
} else if (lsamen_(&c__3, c3, "TRI", 3L, 3L)) {
mults = em * (em * (em * .66666666666666663 + .5) +
.83333333333333337);
adds = em * (em * (em * .66666666666666663 - 1.5) +
.83333333333333337);
/* xGEQRF or xGEQLF: M, N => M, N */
} else if (lsamen_(&c__3, c3, "QRF", 3L, 3L) || lsamen_(&c__3, c3,
"QR2", 3L, 3L) || lsamen_(&c__3, c3, "QLF", 3L, 3L) ||
lsamen_(&c__3, c3, "QL2", 3L, 3L)) {
if (*m >= *n) {
mults = en * (em + 3.8333333333333335 + en / 2. + en * (em -
en / 3.));
adds = en * (en * (em - en / 3. + .5) + .83333333333333337);
} else {
mults = em * (en * 2. + 3.8333333333333335 - em / 2. + em * (
en - em / 3.));
adds = em * (en + .83333333333333337 - em / 2. + em * (en -
em / 3.));
}
/* xGERQF or xGELQF: M, N => M, N */
} else if (lsamen_(&c__3, c3, "RQF", 3L, 3L) || lsamen_(&c__3, c3,
"RQ2", 3L, 3L) || lsamen_(&c__3, c3, "LQF", 3L, 3L) ||
lsamen_(&c__3, c3, "LQ2", 3L, 3L)) {
if (*m >= *n) {
mults = en * (em + 4.833333333333333 + en / 2. + en * (em -
en / 3.));
adds = en * (em + .83333333333333337 + en * (em - en / 3. -
.5));
} else {
mults = em * (en * 2. + 4.833333333333333 - em / 2. + em * (
en - em / 3.));
adds = em * (em / 2. + .83333333333333337 + em * (en - em /
3.));
}
/* xGEQPF: M, N => M, N */
} else if (lsamen_(&c__3, c3, "QPF", 3L, 3L)) {
emn = (doublereal) min(*m,*n);
mults = en * 2 * en + emn * (em * 3 + en * 5 + em * 2 * en - (emn
+ 1) * (en + 4 + em - (emn * 2 + 1) / 3));
adds = en * en + emn * (em * 2 + en + em * 2 * en - (emn + 1) * (
en + 2 + em - (emn * 2 + 1) / 3));
/* xGEQRS or xGERQS: M, N, NRHS => M, N, KL */
} else if (lsamen_(&c__3, c3, "QRS", 3L, 3L) || lsamen_(&c__3, c3,
"RQS", 3L, 3L)) {
mults = ek * (en * (2. - ek) + em * (en * 2. + (em + 1.) / 2.));
adds = ek * (en * (1. - ek) + em * (en * 2. + (em - 1.) / 2.));
/* xGELQS or xGEQLS: M, N, NRHS => M, N, KL */
} else if (lsamen_(&c__3, c3, "LQS", 3L, 3L) || lsamen_(&c__3, c3,
"QLS", 3L, 3L)) {
mults = ek * (em * (2. - ek) + en * (em * 2. + (en + 1.) / 2.));
adds = ek * (em * (1. - ek) + en * (em * 2. + (en - 1.) / 2.));
/* xGEBRD: M, N => M, N */
} else if (lsamen_(&c__3, c3, "BRD", 3L, 3L)) {
if (*m >= *n) {
mults = en * (en * (em * 2. - en * .66666666666666663 + 2.) +
6.666666666666667);
adds = en * (en - em + 1.6666666666666667 + en * (em * 2. -
en * .66666666666666663));
} else {
mults = em * (em * (en * 2. - em * .66666666666666663 + 2.) +
6.666666666666667);
adds = em * (em - en + 1.6666666666666667 + em * (en * 2. -
em * .66666666666666663));
}
/* xGEHRD: N => M */
} else if (lsamen_(&c__3, c3, "HRD", 3L, 3L)) {
if (*m == 1) {
mults = 0.;
adds = 0.;
} else {
mults = em * (em * (em * 1.6666666666666667 + .5) -
1.1666666666666667) - 13.;
adds = em * (em * (em * 1.6666666666666667 - 1.) -
.66666666666666663) - 8.;
}
}
/* ---------------------------- */
/* GB: General Banded matrices */
/* ---------------------------- */
/* Note: The operation count is overestimated because */
/* it is assumed that the factor U fills in to the maximum */
/* extent, i.e., that its bandwidth goes from KU to KL + KU. */
} else if (lsamen_(&c__2, c2, "GB", 2L, 2L)) {
/* xGBTRF: M, N, KL, KU => M, N, KL, KU */
if (lsamen_(&c__3, c3, "TRF", 3L, 3L)) {
for (i = min(*m,*n); i >= 1; --i) {
/* Computing MAX */
/* Computing MIN */
i__3 = *kl, i__4 = *m - i;
i__1 = 0, i__2 = min(i__3,i__4);
wl = (doublereal) max(i__1,i__2);
/* Computing MAX */
/* Computing MIN */
i__3 = *kl + *ku, i__4 = *n - i;
i__1 = 0, i__2 = min(i__3,i__4);
wu = (doublereal) max(i__1,i__2);
mults += wl * (wu + 1.);
adds += wl * wu;
/* L10: */
}
/* xGBTRS: N, NRHS, KL, KU => M, N, KL, KU */
} else if (lsamen_(&c__3, c3, "TRS", 3L, 3L)) {
/* Computing MAX */
/* Computing MIN */
i__3 = *kl, i__4 = *m - 1;
i__1 = 0, i__2 = min(i__3,i__4);
wl = (doublereal) max(i__1,i__2);
/* Computing MAX */
/* Computing MIN */
i__3 = *kl + *ku, i__4 = *m - 1;
i__1 = 0, i__2 = min(i__3,i__4);
wu = (doublereal) max(i__1,i__2);
mults = en * (em * (wl + 1. + wu) - (wl * (wl + 1.) + wu * (wu +
1.)) * .5);
adds = en * (em * (wl + wu) - (wl * (wl + 1.) + wu * (wu + 1.)) *
.5);
}
/* -------------------------------------- */
/* PO: POsitive definite matrices */
/* PP: Positive definite Packed matrices */
/* -------------------------------------- */
} else if (lsamen_(&c__2, c2, "PO", 2L, 2L) || lsamen_(&c__2, c2, "PP",
2L, 2L)) {
/* xPOTRF: N => M */
if (lsamen_(&c__3, c3, "TRF", 3L, 3L)) {
mults = em * (em * (em * .16666666666666666 + .5) +
.33333333333333331);
adds = em * .16666666666666666 * (em * em - 1.);
/* xPOTRS: N, NRHS => M, N */
} else if (lsamen_(&c__3, c3, "TRS", 3L, 3L)) {
mults = en * (em * (em + 1.));
adds = en * (em * (em - 1.));
/* xPOTRI: N => M */
} else if (lsamen_(&c__3, c3, "TRI", 3L, 3L)) {
mults = em * (em * (em * .33333333333333331 + 1.) +
.66666666666666663);
adds = em * (em * (em * .33333333333333331 - .5) +
.16666666666666666);
}
/* ------------------------------------ */
/* PB: Positive definite Band matrices */
/* ------------------------------------ */
} else if (lsamen_(&c__2, c2, "PB", 2L, 2L)) {
/* xPBTRF: N, K => M, KL */
if (lsamen_(&c__3, c3, "TRF", 3L, 3L)) {
mults = ek * (ek * (ek * -.33333333333333331 - 1.) -
.66666666666666663) + em * (ek * (ek * .5 + 1.5) + 1.);
adds = ek * (ek * (ek * -.33333333333333331 - .5) -
.16666666666666666) + em * (ek / 2. * (ek + 1.));
/* xPBTRS: N, NRHS, K => M, N, KL */
} else if (lsamen_(&c__3, c3, "TRS", 3L, 3L)) {
mults = en * ((em * 2 - ek) * (ek + 1.));
adds = en * (ek * (em * 2 - (ek + 1.)));
}
/* -------------------------------------------------------- */
/* SY: SYmmetric indefinite matrices */
/* SP: Symmetric indefinite Packed matrices */
/* HE: HErmitian indefinite matrices (complex only) */
/* HP: Hermitian indefinite Packed matrices (complex only) */
/* -------------------------------------------------------- */
} else if (lsamen_(&c__2, c2, "SY", 2L, 2L) || lsamen_(&c__2, c2, "SP",
2L, 2L) || lsamen_(&c__3, subnam, "ZHE", 6L, 3L) || lsamen_(&c__3,
subnam, "ZHE", 6L, 3L) || lsamen_(&c__3, subnam, "ZHP", 6L, 3L)
|| lsamen_(&c__3, subnam, "ZHP", 6L, 3L)) {
/* xSYTRF: N => M */
if (lsamen_(&c__3, c3, "TRF", 3L, 3L)) {
mults = em * (em * (em * .16666666666666666 + .5) +
3.3333333333333335);
adds = em / 6. * (em * em - 1.);
/* xSYTRS: N, NRHS => M, N */
} else if (lsamen_(&c__3, c3, "TRS", 3L, 3L)) {
mults = en * em * em;
adds = en * (em * (em - 1.));
/* xSYTRI: N => M */
} else if (lsamen_(&c__3, c3, "TRI", 3L, 3L)) {
mults = em * (em * em * .33333333333333331 + .66666666666666663);
adds = em * (em * em * .33333333333333331 - .33333333333333331);
/* xSYTRD, xSYTD2: N => M */
} else if (lsamen_(&c__3, c3, "TRD", 3L, 3L) || lsamen_(&c__3, c3,
"TD2", 3L, 3L)) {
if (*m == 1) {
mults = 0.;
adds = 0.;
} else {
mults = em * (em * (em * .66666666666666663 + 2.5) -
.16666666666666666) - 15.;
adds = em * (em * (em * .66666666666666663 + 1.) -
2.6666666666666665) - 4.;
}
}
/* ------------------- */
/* Triangular matrices */
/* ------------------- */
} else if (lsamen_(&c__2, c2, "TR", 2L, 2L) || lsamen_(&c__2, c2, "TP",
2L, 2L)) {
/* xTRTRS: N, NRHS => M, N */
if (lsamen_(&c__3, c3, "TRS", 3L, 3L)) {
mults = en * em * (em + 1.) / 2.;
adds = en * em * (em - 1.) / 2.;
/* xTRTRI: N => M */
} else if (lsamen_(&c__3, c3, "TRI", 3L, 3L)) {
mults = em * (em * (em * .16666666666666666 + .5) +
.33333333333333331);
adds = em * (em * (em * .16666666666666666 - .5) +
.33333333333333331);
}
} else if (lsamen_(&c__2, c2, "TB", 2L, 2L)) {
/* xTBTRS: N, NRHS, K => M, N, KL */
if (lsamen_(&c__3, c3, "TRS", 3L, 3L)) {
mults = en * (em * (em + 1.) / 2. - (em - ek - 1.) * (em - ek) /
2.);
adds = en * (em * (em - 1.) / 2. - (em - ek - 1.) * (em - ek) /
2.);
}
/* -------------------- */
/* Trapezoidal matrices */
/* -------------------- */
} else if (lsamen_(&c__2, c2, "TZ", 2L, 2L)) {
/* xTZRQF: M, N => M, N */
if (lsamen_(&c__3, c3, "RQF", 3L, 3L)) {
emn = (doublereal) min(*m,*n);
mults = em * 3 * (en - em + 1) + (en * 2 - em * 2 + 3) * (em * em
- emn * (emn + 1) / 2);
adds = (en - em + 1) * (em + em * 2 * em - emn * (emn + 1));
}
/* ------------------- */
/* Orthogonal matrices */
/* ------------------- */
} else if ((sord && lsamen_(&c__2, c2, "OR", 2L, 2L)) || (corz && lsamen_(&
c__2, c2, "UN", 2L, 2L))) {
/* -MQR, -MLQ, -MQL, or -MRQ: M, N, K, SIDE => M, N, KL, KU
*/
/* where KU<= 0 indicates SIDE = 'L' */
/* and KU> 0 indicates SIDE = 'R' */
if (lsamen_(&c__3, c3, "MQR", 3L, 3L) || lsamen_(&c__3, c3, "MLQ", 3L,
3L) || lsamen_(&c__3, c3, "MQL", 3L, 3L) || lsamen_(&c__3,
c3, "MRQ", 3L, 3L)) {
if (*ku <= 0) {
mults = ek * en * (em * 2. + 2. - ek);
adds = ek * en * (em * 2. + 1. - ek);
} else {
mults = ek * (em * (en * 2. - ek) + (em + en + (1. - ek) / 2.)
);
adds = ek * em * (en * 2. + 1. - ek);
}
/* -GQR or -GQL: M, N, K => M, N, KL */
} else if (lsamen_(&c__3, c3, "GQR", 3L, 3L) || lsamen_(&c__3, c3,
"GQL", 3L, 3L)) {
mults = ek * (en * 2. - ek - 1.6666666666666667 + (em * 2. * en +
ek * (ek * .66666666666666663 - em - en)));
adds = ek * (en - em + .33333333333333331 + (em * 2. * en + ek * (
ek * .66666666666666663 - em - en)));
/* -GLQ or -GRQ: M, N, K => M, N, KL */
} else if (lsamen_(&c__3, c3, "GLQ", 3L, 3L) || lsamen_(&c__3, c3,
"GRQ", 3L, 3L)) {
mults = ek * (em + en - ek - .66666666666666663 + (em * 2. * en +
ek * (ek * .66666666666666663 - em - en)));
adds = ek * (em - en + .33333333333333331 + (em * 2. * en + ek * (
ek * .66666666666666663 - em - en)));
}
}
ret_val = mulfac * mults + addfac * adds;
return ret_val;
/* End of DOPLA */
} /* dopla_ */
syntax highlighted by Code2HTML, v. 0.9.1