#include "blaswrap.h" /* -- translated by f2c (version 19990503). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ #include "f2c.h" /* Common Block Declarations */ struct { doublereal ops, itcnt; } latime_; #define latime_1 latime_ /* Table of constant values */ static integer c__12 = 12; static integer c__1 = 1; static doublereal c_b23 = 1.; static integer c__4 = 4; static integer c__2 = 2; static integer c__3 = 3; static integer c__0 = 0; static integer c__8 = 8; static doublereal c_b218 = 0.; /* Subroutine */ int dtim21_(char *line, integer *nsizes, integer *nn, integer *ntypes, logical *dotype, integer *nparms, integer *nnb, integer *nshfts, integer *maxbs, integer *ldas, doublereal *timmin, integer *nout, integer *iseed, doublereal *a, doublereal *h__, doublereal *z__, doublereal *w, doublereal *work, integer *lwork, logical *llwork, integer *iwork, doublereal *times, integer *ldt1, integer *ldt2, integer *ldt3, doublereal *opcnts, integer *ldo1, integer *ldo2, integer *ldo3, integer *info, ftnlen line_len) { /* Initialized data */ static char subnam[9*12] = "DGEHRD " "DHSEQR(E)" "DHSEQR(S)" "DHSEQR(V)" "DTREVC(L)" "DTREVC(R)" "DHSEIN(L)" "DHSEIN(R)" "ORTHES " "HQR " "HQR2 " "INVIT "; static integer inparm[12] = { 2,4,4,4,1,1,1,1,1,1,1,1 }; static char pnames[4*4] = "LDA " "NB " "NS " "MAXB"; static integer kmode[8] = { 4,3,1,5,4,3,1,5 }; static integer kconds[8] = { 1,1,1,1,2,2,2,2 }; /* Format strings */ static char fmt_9999[] = "(1x,a,\002 timing run not attempted -- N > LD" "A\002,/)"; static char fmt_9998[] = "(1x,a,\002 timing run not attempted -- LWORK t" "oo small.\002,/)"; static char fmt_9997[] = "(\002 DTIM21: \002,a,\002 returned INFO=\002,i" "6,\002.\002,/9x,\002N=\002,i6,\002, ITYPE=\002,i6,\002, IPAR=" "\002,i6,\002, ISEED=(\002,3(i5,\002,\002),i5,\002)\002)"; /* System generated locals */ integer opcnts_dim1, opcnts_dim2, opcnts_dim3, opcnts_offset, times_dim1, times_dim2, times_dim3, times_offset, i__1, i__2, i__3, i__4, i__5, i__6; doublereal d__1; /* Builtin functions */ integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); double sqrt(doublereal); /* Local variables */ static integer maxb, ipar; static doublereal time; static integer isub, nmax, j, n, imode; extern doublereal dopla_(char *, integer *, integer *, integer *, integer *, integer *); static integer iinfo, mbmax, nbmax; static doublereal conds; static integer itemp, lastl, nsmax; extern /* Subroutine */ int invit_(integer *, integer *, doublereal *, doublereal *, doublereal *, logical *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *) ; static integer itype, j1, j2, j3, j4; static doublereal s1, s2, rtulp; static integer ic, jc, nb, in; extern doublereal dlamch_(char *); static integer jr; extern /* Subroutine */ int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); extern doublereal dsecnd_(void); static integer ldamin; static char adumma[1*1]; extern /* Subroutine */ int dlatme_(integer *, char *, integer *, doublereal *, integer *, doublereal *, doublereal *, char *, char *, char *, char *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dhsein_(char *, char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); static integer ioldsd[4], iconds; extern /* Subroutine */ int dprtbe_(char *, integer *, logical *, integer *, integer *, integer *, char *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, logical *, integer *, ftnlen, ftnlen), atimin_(char *, char *, integer *, char *, logical *, integer *, integer *, ftnlen, ftnlen, ftnlen), dhseqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); static integer nsbmax; extern /* Subroutine */ int dtrevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); static integer nshift, lastnl; extern /* Subroutine */ int xlaenv_(integer *, integer *); static doublereal untime; static logical runhrd, timsub[12]; extern /* Subroutine */ int orthes_(integer *, integer *, integer *, integer *, doublereal *, doublereal *); static logical runqre; static doublereal ulpinv; static logical runhqr; static doublereal rtulpi; static integer mtypes; static logical runort, runqrs; static integer lda, ldh, ldt, ldw; extern /* Subroutine */ int hqr_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); static doublereal ulp; extern /* Subroutine */ int hqr2_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); /* Fortran I/O blocks */ static cilist io___14 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___15 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___45 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___50 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___53 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___56 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___57 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___58 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___59 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___64 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___65 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___66 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___67 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___68 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___69 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___70 = { 0, 0, 0, fmt_9997, 0 }; #define times_ref(a_1,a_2,a_3,a_4) times[(((a_4)*times_dim3 + (a_3))*\ times_dim2 + (a_2))*times_dim1 + a_1] #define subnam_ref(a_0,a_1) &subnam[(a_1)*9 + a_0 - 9] #define opcnts_ref(a_1,a_2,a_3,a_4) opcnts[(((a_4)*opcnts_dim3 + (a_3))*\ opcnts_dim2 + (a_2))*opcnts_dim1 + a_1] /* -- LAPACK timing routine (version 3.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University September 30, 1994 Purpose ======= DTIM21 times the LAPACK routines for the DOUBLE PRECISION non-symmetric eigenvalue problem. For each N value in NN(1:NSIZES) and .TRUE. value in DOTYPE(1:NTYPES), a matrix will be generated and used to test the selected routines. Thus, NSIZES*(number of .TRUE. values in DOTYPE) matrices will be generated. Arguments ========= LINE (input) CHARACTER*80 On entry, LINE contains the input line which requested this routine. This line may contain a subroutine name, such as DGEHRD, indicating that only routine SGEHRD will be timed, or it may contain a generic name, such as DHS. In this case, the rest of the line is scanned for the first 12 non-blank characters, corresponding to the twelve combinations of subroutine and options: LAPACK: 1: DGEHRD 2: DHSEQR(JOB='E') 3: DHSEQR(JOB='S') 4: DHSEQR(JOB='I') 5: DTREVC(JOB='L') 6: DTREVC(JOB='R') 7: DHSEIN(JOB='L') 8: DHSEIN(JOB='R') EISPACK: 9: ORTHES (compare with DGEHRD) 10: HQR (compare w/ DHSEQR -- JOB='E') 11: HQR2 (compare w/ DHSEQR(JOB='I') plus DTREVC(JOB='R')) 12: INVIT (compare with DHSEIN) If a character is 'T' or 't', the corresponding routine in this path is timed. If the entire line is blank, all the routines in the path are timed. NSIZES (input) INTEGER The number of values of N contained in the vector NN. NN (input) INTEGER array, dimension( NSIZES ) The values of the matrix size N to be tested. For each N value in the array NN, and each .TRUE. value in DOTYPE, a matrix A will be generated and used to test the routines. NTYPES (input) INTEGER The number of types in DOTYPE. Only the first MAXTYP elements will be examined. Exception: if NSIZES=1 and NTYPES=MAXTYP+1, and DOTYPE=MAXTYP*f,t, then the input value of A will be used. DOTYPE (input) LOGICAL If DOTYPE(j) is .TRUE., then a matrix of type j will be generated. The matrix A has the form X**(-1) T X, where X is orthogonal (for j=1--4) or has condition sqrt(ULP) (for j=5--8), and T has random O(1) entries in the upper triangle and: (j=1,5) evenly spaced entries 1, ..., ULP with random signs (j=2,6) geometrically spaced entries 1, ..., ULP with random signs (j=3,7) "clustered" entries 1, ULP,..., ULP with random signs (j=4,8) real or complex conjugate paired eigenvalues randomly chosen from ( ULP, 1 ) on the diagonal. NPARMS (input) INTEGER The number of values in each of the arrays NNB, NSHFTS, MAXBS, and LDAS. For each matrix A generated according to NN and DOTYPE, tests will be run with (NB,NSHIFT,MAXB,LDA)= (NNB(1), NSHFTS(1), MAXBS(1), LDAS(1)),..., (NNB(NPARMS), NSHFTS(NPARMS), MAXBS(NPARMS), LDAS(NPARMS)) NNB (input) INTEGER array, dimension( NPARMS ) The values of the blocksize ("NB") to be tested. NSHFTS (input) INTEGER array, dimension( NPARMS ) The values of the number of shifts ("NSHIFT") to be tested. MAXBS (input) INTEGER array, dimension( NPARMS ) The values of "MAXB", the size of largest submatrix to be processed by DLAHQR (EISPACK method), to be tested. LDAS (input) INTEGER array, dimension( NPARMS ) The values of LDA, the leading dimension of all matrices, to be tested. TIMMIN (input) DOUBLE PRECISION The minimum time a subroutine will be timed. NOUT (input) INTEGER If NOUT > 0 then NOUT specifies the unit number on which the output will be printed. If NOUT <= 0, no output is printed. ISEED (input/output) INTEGER array, dimension( 4 ) The random seed used by the random number generator, used by the test matrix generator. It is used and updated on each call to DTIM21 A (workspace) DOUBLE PRECISION array, dimension( max(NN)*max(LDAS) ) (a) During the testing of DGEHRD, the original matrix to be tested. (b) Later, the Schur form of the original matrix. H (workspace) DOUBLE PRECISION array, dimension( max(NN)*max(LDAS) ) The Hessenberg form of the original matrix. Z (workspace) DOUBLE PRECISION array, dimension( max(NN)*max(LDAS) ) Various output arrays: from DGEHRD and DHSEQR, the orthogonal reduction matrices; from DTREVC and DHSEIN, the eigenvector matrices. W (workspace) DOUBLE PRECISION array, dimension( 2*max(LDAS) ) Treated as an LDA x 2 matrix whose 1st column holds WR, the real parts of the eigenvalues, and whose 2nd column holds WI, the imaginary parts of the eigenvalues of A. WORK (workspace) DOUBLE PRECISION array, dimension( LWORK ) LWORK (input) INTEGER Number of elements in WORK. It must be at least (a) max(NN)*( 3*max(NNB) + 2 ) (b) max(NN)*( max(NNB+NSHFTS) + 1 ) (c) max(NSHFTS)*( max(NSHFTS) + max(NN) ) (d) max(MAXBS)*( max(MAXBS) + max(NN) ) (e) ( max(NN) + 2 )**2 + max(NN) (f) NSIZES*NTYPES*NPARMS LLWORK (workspace) LOGICAL array, dimension( max( max(NN), NPARMS )) IWORK (workspace) INTEGER array, dimension( 2*max(NN) ) Workspace needed for parameters IFAILL and IFAILR in call to DHSEIN. TIMES (output) DOUBLE PRECISION array, dimension (LDT1,LDT2,LDT3,NSUBS) TIMES(i,j,k,l) will be set to the run time (in seconds) for subroutine l, with N=NN(k), matrix type j, and LDA=LDAS(i), MAXB=MAXBS(i), NBLOCK=NNB(i), and NSHIFT=NSHFTS(i). LDT1 (input) INTEGER The first dimension of TIMES. LDT1 >= min( 1, NPARMS ). LDT2 (input) INTEGER The second dimension of TIMES. LDT2 >= min( 1, NTYPES ). LDT3 (input) INTEGER The third dimension of TIMES. LDT3 >= min( 1, NSIZES ). OPCNTS (output) DOUBLE PRECISION array, dimension (LDO1,LDO2,LDO3,NSUBS) OPCNTS(i,j,k,l) will be set to the number of floating-point operations executed by subroutine l, with N=NN(k), matrix type j, and LDA=LDAS(i), MAXB=MAXBS(i), NBLOCK=NNB(i), and NSHIFT=NSHFTS(i). LDO1 (input) INTEGER The first dimension of OPCNTS. LDO1 >= min( 1, NPARMS ). LDO2 (input) INTEGER The second dimension of OPCNTS. LDO2 >= min( 1, NTYPES ). LDO3 (input) INTEGER The third dimension of OPCNTS. LDO3 >= min( 1, NSIZES ). INFO (output) INTEGER Error flag. It will be set to zero if no error occurred. ===================================================================== Parameter adjustments */ --nn; --dotype; --nnb; --nshfts; --maxbs; --ldas; --iseed; --a; --h__; --z__; --w; --work; --llwork; --iwork; times_dim1 = *ldt1; times_dim2 = *ldt2; times_dim3 = *ldt3; times_offset = 1 + times_dim1 * (1 + times_dim2 * (1 + times_dim3 * 1)); times -= times_offset; opcnts_dim1 = *ldo1; opcnts_dim2 = *ldo2; opcnts_dim3 = *ldo3; opcnts_offset = 1 + opcnts_dim1 * (1 + opcnts_dim2 * (1 + opcnts_dim3 * 1) ); opcnts -= opcnts_offset; /* Function Body Quick Return */ *info = 0; if (*nsizes <= 0 || *ntypes <= 0 || *nparms <= 0) { return 0; } /* Extract the timing request from the input line. */ atimin_("DHS", line, &c__12, subnam, timsub, nout, info, (ftnlen)3, ( ftnlen)80, (ftnlen)9); if (*info != 0) { return 0; } /* Compute Maximum Values */ nmax = 0; i__1 = *nsizes; for (j1 = 1; j1 <= i__1; ++j1) { /* Computing MAX */ i__2 = nmax, i__3 = nn[j1]; nmax = max(i__2,i__3); /* L10: */ } ldamin = max(1,nmax) << 1; nbmax = 0; nsmax = 0; mbmax = 0; nsbmax = 0; i__1 = *nparms; for (j1 = 1; j1 <= i__1; ++j1) { /* Computing MIN */ i__2 = ldamin, i__3 = ldas[j1]; ldamin = min(i__2,i__3); /* Computing MAX */ i__2 = nbmax, i__3 = nnb[j1]; nbmax = max(i__2,i__3); /* Computing MAX */ i__2 = nsmax, i__3 = nshfts[j1]; nsmax = max(i__2,i__3); /* Computing MAX */ i__2 = mbmax, i__3 = maxbs[j1]; mbmax = max(i__2,i__3); /* Computing MAX */ i__2 = nsbmax, i__3 = nnb[j1] + nshfts[j1]; nsbmax = max(i__2,i__3); /* L20: */ } /* Check that N <= LDA for the input values. */ if (nmax > ldamin) { *info = -10; io___14.ciunit = *nout; s_wsfe(&io___14); do_fio(&c__1, line, (ftnlen)6); e_wsfe(); return 0; } /* Check LWORK Computing MAX Computing MAX */ i__3 = nbmax * 3 + 2, i__4 = nsbmax + 1; i__1 = nmax * max(i__3,i__4), i__2 = nsmax * (nsmax + nmax), i__1 = max( i__1,i__2), i__2 = mbmax * (mbmax + nmax), i__1 = max(i__1,i__2), i__2 = (nmax + 1) * (nmax + 4), i__1 = max(i__1,i__2), i__2 = * nsizes * *ntypes * *nparms; if (*lwork < max(i__1,i__2)) { *info = -19; io___15.ciunit = *nout; s_wsfe(&io___15); do_fio(&c__1, line, (ftnlen)6); e_wsfe(); return 0; } /* Check to see whether DGEHRD or DHSEQR must be run. RUNQRE -- if DHSEQR must be run to get eigenvalues. RUNQRS -- if DHSEQR must be run to get Schur form. RUNHRD -- if DGEHRD must be run. */ runqrs = FALSE_; runqre = FALSE_; runhrd = FALSE_; if (timsub[4] || timsub[5]) { runqrs = TRUE_; } if (timsub[6] || timsub[7]) { runqre = TRUE_; } if (timsub[1] || timsub[2] || timsub[3] || runqrs || runqre) { runhrd = TRUE_; } if (timsub[2] || timsub[3] || runqrs) { runqre = FALSE_; } if (timsub[3]) { runqrs = FALSE_; } /* Check to see whether ORTHES or HQR must be run. RUNHQR -- if HQR must be run to get eigenvalues. RUNORT -- if ORTHES must be run. */ runhqr = FALSE_; runort = FALSE_; if (timsub[11]) { runhqr = TRUE_; } if (timsub[9] || timsub[10] || runhqr) { runort = TRUE_; } if (timsub[9] || timsub[10]) { runhqr = FALSE_; } if (timsub[8]) { runort = FALSE_; } /* Various Constants */ ulp = dlamch_("Epsilon") * dlamch_("Base"); ulpinv = 1. / ulp; rtulp = sqrt(ulp); rtulpi = 1. / rtulp; /* Zero out OPCNTS, TIMES */ for (j4 = 1; j4 <= 12; ++j4) { i__1 = *nsizes; for (j3 = 1; j3 <= i__1; ++j3) { i__2 = *ntypes; for (j2 = 1; j2 <= i__2; ++j2) { i__3 = *nparms; for (j1 = 1; j1 <= i__3; ++j1) { opcnts_ref(j1, j2, j3, j4) = 0.; times_ref(j1, j2, j3, j4) = 0.; /* L30: */ } /* L40: */ } /* L50: */ } /* L60: */ } /* Do for each value of N: */ i__1 = *nsizes; for (in = 1; in <= i__1; ++in) { n = nn[in]; /* Do for each .TRUE. value in DOTYPE: */ mtypes = min(8,*ntypes); if (*ntypes == 9 && *nsizes == 1) { mtypes = *ntypes; } i__2 = mtypes; for (itype = 1; itype <= i__2; ++itype) { if (! dotype[itype]) { goto L610; } /* Save random number seed for error messages */ for (j = 1; j <= 4; ++j) { ioldsd[j - 1] = iseed[j]; /* L70: */ } /* ----------------------------------------------------------------------- Time the LAPACK Routines Generate A */ if (itype <= 8) { imode = kmode[itype - 1]; iconds = kconds[itype - 1]; if (iconds == 1) { conds = 1.; } else { conds = rtulpi; } *(unsigned char *)&adumma[0] = ' '; dlatme_(&n, "S", &iseed[1], &work[1], &imode, &ulpinv, &c_b23, adumma, "T", "T", "T", &work[n + 1], &c__4, &conds, & n, &n, &c_b23, &a[1], &n, &work[(n << 1) + 1], &iinfo); } /* Time DGEHRD for each pair NNB(j), LDAS(j) */ if (timsub[0]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; /* Computing MIN */ i__4 = n, i__5 = nnb[ipar]; nb = min(i__4,i__5); /* If this combination of (NB,LDA) has occurred before, just use that value. */ lastnl = 0; i__4 = ipar - 1; for (j = 1; j <= i__4; ++j) { /* Computing MIN */ i__5 = n, i__6 = nnb[j]; if (lda == ldas[j] && nb == min(i__5,i__6)) { lastnl = j; } /* L80: */ } if (lastnl == 0) { xlaenv_(&c__1, &nb); xlaenv_(&c__2, &c__2); xlaenv_(&c__3, &nb); /* Time DGEHRD */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L90: dlacpy_("Full", &n, &n, &a[1], &n, &h__[1], &lda); i__4 = *lwork - n; dgehrd_(&n, &c__1, &n, &h__[1], &lda, &work[1], &work[ n + 1], &i__4, &iinfo); if (iinfo != 0) { io___45.ciunit = *nout; s_wsfe(&io___45); do_fio(&c__1, subnam_ref(0, 1), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L90; } /* Subtract the time used in DLACPY. */ s1 = dsecnd_(); i__4 = ic; for (j = 1; j <= i__4; ++j) { dlacpy_("Full", &n, &n, &a[1], &n, &z__[1], &lda); /* L100: */ } s2 = dsecnd_(); untime = s2 - s1; /* Computing MAX */ d__1 = time - untime; times_ref(ipar, itype, in, 1) = max(d__1,0.) / ( doublereal) ic; opcnts_ref(ipar, itype, in, 1) = dopla_("DGEHRD", &n, &c__1, &n, &c__0, &nb); } else { opcnts_ref(ipar, itype, in, 1) = opcnts_ref(lastnl, itype, in, 1); times_ref(ipar, itype, in, 1) = times_ref(lastnl, itype, in, 1); } /* L110: */ } ldh = lda; } else { if (runhrd) { dlacpy_("Full", &n, &n, &a[1], &n, &h__[1], &n) ; i__3 = *lwork - n; dgehrd_(&n, &c__1, &n, &h__[1], &n, &work[1], &work[n + 1] , &i__3, &iinfo); if (iinfo != 0) { io___50.ciunit = *nout; s_wsfe(&io___50); do_fio(&c__1, subnam_ref(0, 1), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&itype, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } ldh = n; } } /* Time DHSEQR with JOB='E' for each 4-tuple NNB(j), NSHFTS(j), MAXBS(j), LDAS(j) */ if (timsub[1]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; nb = 1; nshift = nshfts[ipar]; maxb = maxbs[ipar]; xlaenv_(&c__4, &nshift); xlaenv_(&c__8, &maxb); /* Time DHSEQR with JOB='E' */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L120: dlacpy_("Full", &n, &n, &h__[1], &ldh, &a[1], &lda); dhseqr_("E", "N", &n, &c__1, &n, &a[1], &lda, &w[1], &w[ lda + 1], &z__[1], &lda, &work[1], lwork, &iinfo); if (iinfo != 0) { io___53.ciunit = *nout; s_wsfe(&io___53); do_fio(&c__1, subnam_ref(0, 2), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&itype, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof(integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L120; } /* Subtract the time used in DLACPY. */ s1 = dsecnd_(); i__4 = ic; for (j = 1; j <= i__4; ++j) { dlacpy_("Full", &n, &n, &h__[1], &ldh, &z__[1], &lda); /* L130: */ } s2 = dsecnd_(); untime = s2 - s1; /* Computing MAX */ d__1 = time - untime; times_ref(ipar, itype, in, 2) = max(d__1,0.) / ( doublereal) ic; opcnts_ref(ipar, itype, in, 2) = latime_1.ops / ( doublereal) ic; /* L140: */ } ldt = 0; ldw = lda; } else { if (runqre) { dlacpy_("Full", &n, &n, &h__[1], &ldh, &a[1], &n); dhseqr_("E", "N", &n, &c__1, &n, &a[1], &n, &w[1], &w[n + 1], &z__[1], &n, &work[1], lwork, &iinfo); if (iinfo != 0) { io___56.ciunit = *nout; s_wsfe(&io___56); do_fio(&c__1, subnam_ref(0, 2), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&itype, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } ldt = 0; ldw = n; } } /* Time DHSEQR with JOB='S' for each 4-tuple NNB(j), NSHFTS(j), MAXBS(j), LDAS(j) */ if (timsub[2]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; nshift = nshfts[ipar]; maxb = maxbs[ipar]; nb = 1; xlaenv_(&c__4, &nshift); xlaenv_(&c__8, &maxb); /* Time DHSEQR with JOB='S' */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L150: dlacpy_("Full", &n, &n, &h__[1], &ldh, &a[1], &lda); dhseqr_("S", "N", &n, &c__1, &n, &a[1], &lda, &w[1], &w[ lda + 1], &z__[1], &lda, &work[1], lwork, &iinfo); if (iinfo != 0) { io___57.ciunit = *nout; s_wsfe(&io___57); do_fio(&c__1, subnam_ref(0, 3), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&itype, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof(integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L150; } /* Subtract the time used in DLACPY. */ s1 = dsecnd_(); i__4 = ic; for (j = 1; j <= i__4; ++j) { dlacpy_("Full", &n, &n, &h__[1], &ldh, &z__[1], &lda); /* L160: */ } s2 = dsecnd_(); untime = s2 - s1; /* Computing MAX */ d__1 = time - untime; times_ref(ipar, itype, in, 3) = max(d__1,0.) / ( doublereal) ic; opcnts_ref(ipar, itype, in, 3) = latime_1.ops / ( doublereal) ic; /* L170: */ } ldt = lda; ldw = lda; } else { if (runqrs) { dlacpy_("Full", &n, &n, &h__[1], &ldh, &a[1], &n); dhseqr_("S", "N", &n, &c__1, &n, &a[1], &n, &w[1], &w[n + 1], &z__[1], &n, &work[1], lwork, &iinfo); if (iinfo != 0) { io___58.ciunit = *nout; s_wsfe(&io___58); do_fio(&c__1, subnam_ref(0, 3), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&itype, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } ldt = n; ldw = n; } } /* Time DHSEQR with JOB='I' for each 4-tuple NNB(j), NSHFTS(j), MAXBS(j), LDAS(j) */ if (timsub[3]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; nshift = nshfts[ipar]; maxb = maxbs[ipar]; nb = 1; xlaenv_(&c__4, &nshift); xlaenv_(&c__8, &maxb); /* Time DHSEQR with JOB='I' */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L180: dlacpy_("Full", &n, &n, &h__[1], &ldh, &a[1], &lda); dhseqr_("S", "I", &n, &c__1, &n, &a[1], &lda, &w[1], &w[ lda + 1], &z__[1], &lda, &work[1], lwork, &iinfo); if (iinfo != 0) { io___59.ciunit = *nout; s_wsfe(&io___59); do_fio(&c__1, subnam_ref(0, 4), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&itype, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof(integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L180; } /* Subtract the time used in DLACPY. */ s1 = dsecnd_(); i__4 = ic; for (j = 1; j <= i__4; ++j) { dlacpy_("Full", &n, &n, &h__[1], &ldh, &z__[1], &lda); /* L190: */ } s2 = dsecnd_(); untime = s2 - s1; /* Computing MAX */ d__1 = time - untime; times_ref(ipar, itype, in, 4) = max(d__1,0.) / ( doublereal) ic; opcnts_ref(ipar, itype, in, 4) = latime_1.ops / ( doublereal) ic; /* L200: */ } ldt = lda; ldw = lda; } /* Time DTREVC and DHSEIN with various values of LDA Select All Eigenvectors */ i__3 = n; for (j = 1; j <= i__3; ++j) { llwork[j] = TRUE_; /* L210: */ } i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; /* If this value of LDA has come up before, just use the value previously computed. */ lastl = 0; i__4 = ipar - 1; for (j = 1; j <= i__4; ++j) { if (lda == ldas[j]) { lastl = j; } /* L220: */ } /* Time DTREVC */ if ((timsub[4] || timsub[5]) && lastl == 0) { /* Copy T (which is in A) if necessary to get right LDA. */ if (lda > ldt) { for (jc = n; jc >= 1; --jc) { for (jr = n; jr >= 1; --jr) { a[jr + (jc - 1) * lda] = a[jr + (jc - 1) * ldt]; /* L230: */ } /* L240: */ } } else if (lda < ldt) { i__4 = n; for (jc = 1; jc <= i__4; ++jc) { i__5 = n; for (jr = 1; jr <= i__5; ++jr) { a[jr + (jc - 1) * lda] = a[jr + (jc - 1) * ldt]; /* L250: */ } /* L260: */ } } ldt = lda; /* Time DTREVC for Left Eigenvectors */ if (timsub[4]) { ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L270: dtrevc_("L", "A", &llwork[1], &n, &a[1], &lda, &z__[1] , &lda, &z__[1], &lda, &n, &itemp, &work[1], & iinfo); if (iinfo != 0) { io___64.ciunit = *nout; s_wsfe(&io___64); do_fio(&c__1, subnam_ref(0, 5), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L270; } times_ref(ipar, itype, in, 5) = time / (doublereal) ic; opcnts_ref(ipar, itype, in, 5) = latime_1.ops / ( doublereal) ic; } /* Time DTREVC for Right Eigenvectors */ if (timsub[5]) { ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L280: dtrevc_("R", "A", &llwork[1], &n, &a[1], &lda, &z__[1] , &lda, &z__[1], &lda, &n, &itemp, &work[1], & iinfo); if (iinfo != 0) { io___65.ciunit = *nout; s_wsfe(&io___65); do_fio(&c__1, subnam_ref(0, 6), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L280; } times_ref(ipar, itype, in, 6) = time / (doublereal) ic; opcnts_ref(ipar, itype, in, 6) = latime_1.ops / ( doublereal) ic; } } else { if (timsub[4]) { opcnts_ref(ipar, itype, in, 5) = opcnts_ref(lastl, itype, in, 5); times_ref(ipar, itype, in, 5) = times_ref(lastl, itype, in, 5); } if (timsub[5]) { opcnts_ref(ipar, itype, in, 6) = opcnts_ref(lastl, itype, in, 6); times_ref(ipar, itype, in, 6) = times_ref(lastl, itype, in, 6); } } /* Time DHSEIN */ if ((timsub[6] || timsub[7]) && lastl == 0) { /* Copy H if necessary to get right LDA. */ if (lda > ldh) { for (jc = n; jc >= 1; --jc) { for (jr = n; jr >= 1; --jr) { h__[jr + (jc - 1) * lda] = h__[jr + (jc - 1) * ldh]; /* L290: */ } w[jc + lda] = w[jc + ldh]; /* L300: */ } } else if (lda < ldh) { i__4 = n; for (jc = 1; jc <= i__4; ++jc) { i__5 = n; for (jr = 1; jr <= i__5; ++jr) { h__[jr + (jc - 1) * lda] = h__[jr + (jc - 1) * ldh]; /* L310: */ } w[jc + lda] = w[jc + ldh]; /* L320: */ } } ldh = lda; /* Copy W if necessary to get right LDA. */ if (lda > ldw) { for (j = n; j >= 1; --j) { w[j + lda] = w[j + ldw]; /* L330: */ } } else if (lda < ldw) { i__4 = n; for (j = 1; j <= i__4; ++j) { w[j + lda] = w[j + ldw]; /* L340: */ } } ldw = lda; /* Time DHSEIN for Left Eigenvectors */ if (timsub[6]) { ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L350: dhsein_("L", "Q", "N", &llwork[1], &n, &h__[1], &lda, &w[1], &w[lda + 1], &z__[1], &lda, &z__[1], & lda, &n, &itemp, &work[1], &iwork[1], &iwork[ n + 1], &iinfo); if (iinfo != 0) { io___66.ciunit = *nout; s_wsfe(&io___66); do_fio(&c__1, subnam_ref(0, 7), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L350; } times_ref(ipar, itype, in, 7) = time / (doublereal) ic; opcnts_ref(ipar, itype, in, 7) = latime_1.ops / ( doublereal) ic; } /* Time DHSEIN for Right Eigenvectors */ if (timsub[7]) { ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L360: dhsein_("R", "Q", "N", &llwork[1], &n, &h__[1], &lda, &w[1], &w[lda + 1], &z__[1], &lda, &z__[1], & lda, &n, &itemp, &work[1], &iwork[1], &iwork[ n + 1], &iinfo); if (iinfo != 0) { io___67.ciunit = *nout; s_wsfe(&io___67); do_fio(&c__1, subnam_ref(0, 8), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L360; } times_ref(ipar, itype, in, 8) = time / (doublereal) ic; opcnts_ref(ipar, itype, in, 8) = latime_1.ops / ( doublereal) ic; } } else { if (timsub[6]) { opcnts_ref(ipar, itype, in, 7) = opcnts_ref(lastl, itype, in, 7); times_ref(ipar, itype, in, 7) = times_ref(lastl, itype, in, 7); } if (timsub[7]) { opcnts_ref(ipar, itype, in, 8) = opcnts_ref(lastl, itype, in, 8); times_ref(ipar, itype, in, 8) = times_ref(lastl, itype, in, 8); } } /* L370: */ } /* ----------------------------------------------------------------------- Time the EISPACK Routines Restore random number seed */ for (j = 1; j <= 4; ++j) { iseed[j] = ioldsd[j - 1]; /* L380: */ } /* Re-generate A */ if (itype <= 8) { imode = kmode[itype - 1]; if (iconds == 1) { conds = 1.; } else { conds = rtulpi; } dlatme_(&n, "S", &iseed[1], &work[1], &imode, &ulpinv, &c_b23, adumma, "T", "T", "T", &work[n + 1], &c__4, &conds, & n, &n, &c_b23, &a[1], &n, &work[(n << 1) + 1], &iinfo); } /* Time ORTHES for each LDAS(j) */ if (timsub[8]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; /* If this value of LDA has come up before, just use the value previously computed. */ lastl = 0; i__4 = ipar - 1; for (j = 1; j <= i__4; ++j) { if (lda == ldas[j]) { lastl = j; } /* L390: */ } if (lastl == 0) { /* Time ORTHES */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L400: dlacpy_("Full", &n, &n, &a[1], &n, &h__[1], &lda); orthes_(&lda, &n, &c__1, &n, &h__[1], &work[1]); s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L400; } /* Subtract the time used in DLACPY. */ s1 = dsecnd_(); i__4 = ic; for (j = 1; j <= i__4; ++j) { dlacpy_("Full", &n, &n, &a[1], &n, &z__[1], &lda); /* L410: */ } s2 = dsecnd_(); untime = s2 - s1; /* OPS1 = ( 20*N**3 - 3*N**2 - 23*N ) / 6 - 17 Computing MAX */ d__1 = time - untime; times_ref(ipar, itype, in, 9) = max(d__1,0.) / ( doublereal) ic; opcnts_ref(ipar, itype, in, 9) = latime_1.ops / ( doublereal) ic; } else { opcnts_ref(ipar, itype, in, 9) = opcnts_ref(lastl, itype, in, 9); times_ref(ipar, itype, in, 9) = times_ref(lastl, itype, in, 9); } ldh = lda; /* L420: */ } } else { if (runort) { dlacpy_("Full", &n, &n, &a[1], &n, &h__[1], &n) ; orthes_(&n, &n, &c__1, &n, &h__[1], &work[1]); ldh = n; } } /* Time HQR for each LDAS(j) */ if (timsub[9]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; /* If this value of LDA has come up before, just use the value previously computed. */ lastl = 0; i__4 = ipar - 1; for (j = 1; j <= i__4; ++j) { if (lda == ldas[j]) { lastl = j; } /* L430: */ } if (lastl == 0) { /* Time HQR */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L440: dlacpy_("Full", &n, &n, &h__[1], &ldh, &a[1], &lda); hqr_(&lda, &n, &c__1, &n, &a[1], &w[1], &w[lda + 1], & iinfo); if (iinfo != 0) { io___68.ciunit = *nout; s_wsfe(&io___68); do_fio(&c__1, subnam_ref(0, 10), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L440; } /* Subtract the time used in DLACPY. */ s1 = dsecnd_(); i__4 = ic; for (j = 1; j <= i__4; ++j) { dlacpy_("Full", &n, &n, &h__[1], &ldh, &z__[1], & lda); /* L450: */ } s2 = dsecnd_(); untime = s2 - s1; /* Computing MAX */ d__1 = time - untime; times_ref(ipar, itype, in, 10) = max(d__1,0.) / ( doublereal) ic; opcnts_ref(ipar, itype, in, 10) = latime_1.ops / ( doublereal) ic; } else { opcnts_ref(ipar, itype, in, 10) = opcnts_ref(lastl, itype, in, 10); times_ref(ipar, itype, in, 10) = times_ref(lastl, itype, in, 10); } ldw = lda; /* L460: */ } } else { if (runhqr) { dlacpy_("Full", &n, &n, &a[1], &n, &h__[1], &n) ; hqr_(&n, &n, &c__1, &n, &a[1], &w[1], &w[n + 1], &iinfo); ldw = n; } } /* Time HQR2 for each LDAS(j) */ if (timsub[10]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; /* If this value of LDA has come up before, just use the value previously computed. */ lastl = 0; i__4 = ipar - 1; for (j = 1; j <= i__4; ++j) { if (lda == ldas[j]) { lastl = j; } /* L470: */ } if (lastl == 0) { /* Time HQR2 */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L480: dlacpy_("Full", &n, &n, &h__[1], &ldh, &a[1], &lda); dlaset_("Full", &n, &n, &c_b218, &c_b23, &z__[1], & lda); hqr2_(&lda, &n, &c__1, &n, &a[1], &w[1], &w[lda + 1], &z__[1], &iinfo); if (iinfo != 0) { io___69.ciunit = *nout; s_wsfe(&io___69); do_fio(&c__1, subnam_ref(0, 11), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L480; } /* Subtract the time used in DLACPY. */ s1 = dsecnd_(); i__4 = ic; for (j = 1; j <= i__4; ++j) { dlacpy_("Full", &n, &n, &h__[1], &ldh, &z__[1], & lda); /* L490: */ } s2 = dsecnd_(); untime = s2 - s1; /* Computing MAX */ d__1 = time - untime; times_ref(ipar, itype, in, 11) = max(d__1,0.) / ( doublereal) ic; opcnts_ref(ipar, itype, in, 11) = latime_1.ops / ( doublereal) ic; } else { opcnts_ref(ipar, itype, in, 11) = opcnts_ref(lastl, itype, in, 11); times_ref(ipar, itype, in, 11) = times_ref(lastl, itype, in, 11); } ldw = lda; /* L500: */ } } /* Time INVIT for each LDAS(j) Select All Eigenvectors */ i__3 = n; for (j = 1; j <= i__3; ++j) { llwork[j] = TRUE_; /* L510: */ } if (timsub[11]) { i__3 = *nparms; for (ipar = 1; ipar <= i__3; ++ipar) { lda = ldas[ipar]; /* If this value of LDA has come up before, just use the value previously computed. */ lastl = 0; i__4 = ipar - 1; for (j = 1; j <= i__4; ++j) { if (lda == ldas[j]) { lastl = j; } /* L520: */ } if (lastl == 0) { /* Copy H if necessary to get right LDA. */ if (lda > ldh) { for (jc = n; jc >= 1; --jc) { for (jr = n; jr >= 1; --jr) { h__[jr + (jc - 1) * lda] = h__[jr + (jc - 1) * ldh]; /* L530: */ } /* L540: */ } } else if (lda < ldh) { i__4 = n; for (jc = 1; jc <= i__4; ++jc) { i__5 = n; for (jr = 1; jr <= i__5; ++jr) { h__[jr + (jc - 1) * lda] = h__[jr + (jc - 1) * ldh]; /* L550: */ } /* L560: */ } } ldh = lda; /* Copy W if necessary to get right LDA. */ if (lda > ldw) { for (j = n; j >= 1; --j) { w[j + lda] = w[j + ldw]; /* L570: */ } } else if (lda < ldw) { i__4 = n; for (j = 1; j <= i__4; ++j) { w[j + lda] = w[j + ldw]; /* L580: */ } } ldw = lda; /* Time INVIT for right eigenvectors. */ ic = 0; latime_1.ops = 0.; s1 = dsecnd_(); L590: invit_(&lda, &n, &h__[1], &w[1], &w[lda + 1], &llwork[ 1], &n, &itemp, &z__[1], &iinfo, &work[(n << 1) + 1], &work[1], &work[n + 1]); if (iinfo != 0) { io___70.ciunit = *nout; s_wsfe(&io___70); do_fio(&c__1, subnam_ref(0, 12), (ftnlen)9); do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)) ; do_fio(&c__1, (char *)&itype, (ftnlen)sizeof( integer)); do_fio(&c__1, (char *)&ipar, (ftnlen)sizeof( integer)); do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof( integer)); e_wsfe(); *info = abs(iinfo); goto L610; } s2 = dsecnd_(); time = s2 - s1; ++ic; if (time < *timmin) { goto L590; } /* TIME = TIME / DOUBLE PRECISION( IC ) OPS1 = OPS / DOUBLE PRECISION( IC ) OPCNTS( IPAR, ITYPE, IN, 12 ) = OPS1 TIMES( IPAR, ITYPE, IN, 12 ) = DMFLOP( OPS1, TIME, $ IINFO ) */ times_ref(ipar, itype, in, 12) = time / (doublereal) ic; opcnts_ref(ipar, itype, in, 12) = latime_1.ops / ( doublereal) ic; } else { opcnts_ref(ipar, itype, in, 12) = opcnts_ref(lastl, itype, in, 12); times_ref(ipar, itype, in, 12) = times_ref(lastl, itype, in, 12); } /* L600: */ } } L610: ; } /* L620: */ } /* ----------------------------------------------------------------------- Print a table of results for each timed routine. */ isub = 1; if (timsub[isub - 1]) { dprtbe_(subnam_ref(0, isub), &mtypes, &dotype[1], nsizes, &nn[1], & inparm[isub - 1], pnames, nparms, &ldas[1], &nnb[1], &nshfts[ 1], &maxbs[1], &opcnts_ref(1, 1, 1, isub), ldo1, ldo2, & times_ref(1, 1, 1, isub), ldt1, ldt2, &work[1], &llwork[1], nout, (ftnlen)9, (ftnlen)4); } i__1 = *nparms; for (in = 1; in <= i__1; ++in) { nnb[in] = 1; /* L630: */ } for (isub = 2; isub <= 12; ++isub) { if (timsub[isub - 1]) { dprtbe_(subnam_ref(0, isub), &mtypes, &dotype[1], nsizes, &nn[1], &inparm[isub - 1], pnames, nparms, &ldas[1], &nnb[1], & nshfts[1], &maxbs[1], &opcnts_ref(1, 1, 1, isub), ldo1, ldo2, ×_ref(1, 1, 1, isub), ldt1, ldt2, &work[1], & llwork[1], nout, (ftnlen)9, (ftnlen)4); } /* L640: */ } return 0; /* End of DTIM21 */ } /* dtim21_ */ #undef opcnts_ref #undef subnam_ref #undef times_ref