Update to 2.0.0 tree from current Fremantle build
[opencv] / 3rdparty / lapack / iparmq.c
diff --git a/3rdparty/lapack/iparmq.c b/3rdparty/lapack/iparmq.c
new file mode 100644 (file)
index 0000000..d5bbd88
--- /dev/null
@@ -0,0 +1,269 @@
+#include "clapack.h"
+
+integer iparmq_(integer *ispec, char *name__, char *opts, integer *n, integer 
+       *ilo, integer *ihi, integer *lwork)
+{
+    /* System generated locals */
+    integer ret_val, i__1, i__2;
+    real r__1;
+
+    /* Builtin functions */
+    double log(doublereal);
+    integer i_nint(real *);
+
+    /* Local variables */
+    integer nh, ns;
+
+
+/*  -- LAPACK auxiliary routine (version 3.1) -- */
+/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/*     November 2006 */
+
+/*     .. Scalar Arguments .. */
+
+/*  Purpose */
+/*  ======= */
+
+/*       This program sets problem and machine dependent parameters */
+/*       useful for xHSEQR and its subroutines. It is called whenever */
+/*       ILAENV is called with 12 <= ISPEC <= 16 */
+
+/*  Arguments */
+/*  ========= */
+
+/*       ISPEC  (input) integer scalar */
+/*              ISPEC specifies which tunable parameter IPARMQ should */
+/*              return. */
+
+/*              ISPEC=12: (INMIN)  Matrices of order nmin or less */
+/*                        are sent directly to xLAHQR, the implicit */
+/*                        double shift QR algorithm.  NMIN must be */
+/*                        at least 11. */
+
+/*              ISPEC=13: (INWIN)  Size of the deflation window. */
+/*                        This is best set greater than or equal to */
+/*                        the number of simultaneous shifts NS. */
+/*                        Larger matrices benefit from larger deflation */
+/*                        windows. */
+
+/*              ISPEC=14: (INIBL) Determines when to stop nibbling and */
+/*                        invest in an (expensive) multi-shift QR sweep. */
+/*                        If the aggressive early deflation subroutine */
+/*                        finds LD converged eigenvalues from an order */
+/*                        NW deflation window and LD.GT.(NW*NIBBLE)/100, */
+/*                        then the next QR sweep is skipped and early */
+/*                        deflation is applied immediately to the */
+/*                        remaining active diagonal block.  Setting */
+/*                        IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a */
+/*                        multi-shift QR sweep whenever early deflation */
+/*                        finds a converged eigenvalue.  Setting */
+/*                        IPARMQ(ISPEC=14) greater than or equal to 100 */
+/*                        prevents TTQRE from skipping a multi-shift */
+/*                        QR sweep. */
+
+/*              ISPEC=15: (NSHFTS) The number of simultaneous shifts in */
+/*                        a multi-shift QR iteration. */
+
+/*              ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the */
+/*                        following meanings. */
+/*                        0:  During the multi-shift QR sweep, */
+/*                            xLAQR5 does not accumulate reflections and */
+/*                            does not use matrix-matrix multiply to */
+/*                            update the far-from-diagonal matrix */
+/*                            entries. */
+/*                        1:  During the multi-shift QR sweep, */
+/*                            xLAQR5 and/or xLAQRaccumulates reflections and uses */
+/*                            matrix-matrix multiply to update the */
+/*                            far-from-diagonal matrix entries. */
+/*                        2:  During the multi-shift QR sweep. */
+/*                            xLAQR5 accumulates reflections and takes */
+/*                            advantage of 2-by-2 block structure during */
+/*                            matrix-matrix multiplies. */
+/*                        (If xTRMM is slower than xGEMM, then */
+/*                        IPARMQ(ISPEC=16)=1 may be more efficient than */
+/*                        IPARMQ(ISPEC=16)=2 despite the greater level of */
+/*                        arithmetic work implied by the latter choice.) */
+
+/*       NAME    (input) character string */
+/*               Name of the calling subroutine */
+
+/*       OPTS    (input) character string */
+/*               This is a concatenation of the string arguments to */
+/*               TTQRE. */
+
+/*       N       (input) integer scalar */
+/*               N is the order of the Hessenberg matrix H. */
+
+/*       ILO     (input) INTEGER */
+/*       IHI     (input) INTEGER */
+/*               It is assumed that H is already upper triangular */
+/*               in rows and columns 1:ILO-1 and IHI+1:N. */
+
+/*       LWORK   (input) integer scalar */
+/*               The amount of workspace available. */
+
+/*  Further Details */
+/*  =============== */
+
+/*       Little is known about how best to choose these parameters. */
+/*       It is possible to use different values of the parameters */
+/*       for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR. */
+
+/*       It is probably best to choose different parameters for */
+/*       different matrices and different parameters at different */
+/*       times during the iteration, but this has not been */
+/*       implemented --- yet. */
+
+
+/*       The best choices of most of the parameters depend */
+/*       in an ill-understood way on the relative execution */
+/*       rate of xLAQR3 and xLAQR5 and on the nature of each */
+/*       particular eigenvalue problem.  Experiment may be the */
+/*       only practical way to determine which choices are most */
+/*       effective. */
+
+/*       Following is a list of default values supplied by IPARMQ. */
+/*       These defaults may be adjusted in order to attain better */
+/*       performance in any particular computational environment. */
+
+/*       IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point. */
+/*                        Default: 75. (Must be at least 11.) */
+
+/*       IPARMQ(ISPEC=13) Recommended deflation window size. */
+/*                        This depends on ILO, IHI and NS, the */
+/*                        number of simultaneous shifts returned */
+/*                        by IPARMQ(ISPEC=15).  The default for */
+/*                        (IHI-ILO+1).LE.500 is NS.  The default */
+/*                        for (IHI-ILO+1).GT.500 is 3*NS/2. */
+
+/*       IPARMQ(ISPEC=14) Nibble crossover point.  Default: 14. */
+
+/*       IPARMQ(ISPEC=15) Number of simultaneous shifts, NS. */
+/*                        a multi-shift QR iteration. */
+
+/*                        If IHI-ILO+1 is ... */
+
+/*                        greater than      ...but less    ... the */
+/*                        or equal to ...      than        default is */
+
+/*                                0               30       NS =   2+ */
+/*                               30               60       NS =   4+ */
+/*                               60              150       NS =  10 */
+/*                              150              590       NS =  ** */
+/*                              590             3000       NS =  64 */
+/*                             3000             6000       NS = 128 */
+/*                             6000             infinity   NS = 256 */
+
+/*                    (+)  By default matrices of this order are */
+/*                         passed to the implicit double shift routine */
+/*                         xLAHQR.  See IPARMQ(ISPEC=12) above.   These */
+/*                         values of NS are used only in case of a rare */
+/*                         xLAHQR failure. */
+
+/*                    (**) The asterisks (**) indicate an ad-hoc */
+/*                         function increasing from 10 to 64. */
+
+/*       IPARMQ(ISPEC=16) Select structured matrix multiply. */
+/*                        (See ISPEC=16 above for details.) */
+/*                        Default: 3. */
+
+/*     ================================================================ */
+/*     .. Parameters .. */
+/*     .. */
+/*     .. Local Scalars .. */
+/*     .. */
+/*     .. Intrinsic Functions .. */
+/*     .. */
+/*     .. Executable Statements .. */
+    if (*ispec == 15 || *ispec == 13 || *ispec == 16) {
+
+/*        ==== Set the number simultaneous shifts ==== */
+
+       nh = *ihi - *ilo + 1;
+       ns = 2;
+       if (nh >= 30) {
+           ns = 4;
+       }
+       if (nh >= 60) {
+           ns = 10;
+       }
+       if (nh >= 150) {
+/* Computing MAX */
+           r__1 = (real)(log((doublereal) nh) / log(2.));
+           i__1 = 10, i__2 = nh / i_nint(&r__1);
+           ns = max(i__1,i__2);
+       }
+       if (nh >= 590) {
+           ns = 64;
+       }
+       if (nh >= 3000) {
+           ns = 128;
+       }
+       if (nh >= 6000) {
+           ns = 256;
+       }
+/* Computing MAX */
+       i__1 = 2, i__2 = ns - ns % 2;
+       ns = max(i__1,i__2);
+    }
+
+    if (*ispec == 12) {
+
+
+/*        ===== Matrices of order smaller than NMIN get sent */
+/*        .     to xLAHQR, the classic double shift algorithm. */
+/*        .     This must be at least 11. ==== */
+
+       ret_val = 75;
+
+    } else if (*ispec == 14) {
+
+/*        ==== INIBL: skip a multi-shift qr iteration and */
+/*        .    whenever aggressive early deflation finds */
+/*        .    at least (NIBBLE*(window size)/100) deflations. ==== */
+
+       ret_val = 14;
+
+    } else if (*ispec == 15) {
+
+/*        ==== NSHFTS: The number of simultaneous shifts ===== */
+
+       ret_val = ns;
+
+    } else if (*ispec == 13) {
+
+/*        ==== NW: deflation window size.  ==== */
+
+       if (nh <= 500) {
+           ret_val = ns;
+       } else {
+           ret_val = ns * 3 / 2;
+       }
+
+    } else if (*ispec == 16) {
+
+/*        ==== IACC22: Whether to accumulate reflections */
+/*        .     before updating the far-from-diagonal elements */
+/*        .     and whether to use 2-by-2 block structure while */
+/*        .     doing it.  A small amount of work could be saved */
+/*        .     by making this choice dependent also upon the */
+/*        .     NH=IHI-ILO+1. */
+
+       ret_val = 0;
+       if (ns >= 14) {
+           ret_val = 1;
+       }
+       if (ns >= 14) {
+           ret_val = 2;
+       }
+
+    } else {
+/*        ===== invalid value of ispec ===== */
+       ret_val = -1;
+
+    }
+
+/*     ==== End of IPARMQ ==== */
+
+    return ret_val;
+} /* iparmq_ */