SUBROUTINE DTIM22( LINE, NSIZES, NN, NTYPES, DOTYPE, NPARMS, NNB, $ LDAS, TIMMIN, NOUT, ISEED, A, D, E, E2, Z, Z1, $ WORK, LWORK, LLWORK, IWORK, TIMES, LDT1, LDT2, $ LDT3, OPCNTS, LDO1, LDO2, LDO3, INFO ) * * -- LAPACK timing routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * February 20, 2000 * * .. Scalar Arguments .. CHARACTER*80 LINE INTEGER INFO, LDO1, LDO2, LDO3, LDT1, LDT2, LDT3, $ LWORK, NOUT, NPARMS, NSIZES, NTYPES DOUBLE PRECISION TIMMIN * .. * .. Array Arguments .. LOGICAL DOTYPE( * ), LLWORK( * ) INTEGER ISEED( * ), IWORK( * ), LDAS( * ), NN( * ), $ NNB( * ) DOUBLE PRECISION A( * ), D( * ), E( * ), E2( * ), $ OPCNTS( LDO1, LDO2, LDO3, * ), $ TIMES( LDT1, LDT2, LDT3, * ), WORK( * ), $ Z( * ), Z1( * ) * .. * * Purpose * ======= * * DTIM22 times the LAPACK routines for the real 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 DSYTRD, indicating that only routine SSYTRD will * be timed, or it may contain a generic name, such as DST. * In this case, the rest of the line is scanned for the * first 23 non-blank characters, corresponding to the eight * combinations of subroutine and options: * LAPACK: * 1: DSYTRD * 2: DORGTR * 3: DORMTR * 4: DSTEQR(VECT='N') * 5: DSTEQR(VECT='V') * 6: DSTERF * 7: DPTEQR(VECT='N') * 8: DPTEQR(VECT='V') * 9: DSTEBZ(RANGE='I') * 10: DSTEBZ(RANGE='V') * 11: DSTEIN * 12: DSTEDC(COMPQ='N') * 13: DSTEDC(COMPQ='I') * 14: DSTEDC(COMPQ='V') * 15: DSTEGR(COMPQ='N') * 16: DSTEGR(COMPQ='V') * EISPACK: * 17: TRED1 (compare with DSYTRD) * 18: IMTQL1 (compare w/ DSTEQR -- VECT='N') * 19: IMTQL2 (compare w/ DSTEQR -- VECT='V') * 20: TQLRAT (compare with DSTERF) * 21: TRIDIB (compare with DSTEBZ -- RANGE='I') * 22: BISECT (compare with DSTEBZ -- RANGE='V') * 23: TINVIT (compare with DSTEIN) * 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) D X, where * X is orthogonal and D is diagonal with: * (j=1) evenly spaced entries 1, ..., ULP with random signs. * (j=2) geometrically spaced entries 1, ..., ULP with random * signs. * (j=3) "clustered" entries 1, ULP,..., ULP with random * signs. * (j=4) entries randomly chosen from ( ULP, 1 ). * * NPARMS (input) INTEGER * The number of values in each of the arrays NNB and LDAS. * For each matrix A generated according to NN and DOTYPE, * tests will be run with (NB,LDA)= * (NNB(1),LDAS(1)),...,(NNB(NPARMS), LDAS(NPARMS)) * * NNB (input) INTEGER array, dimension( NPARMS ) * The values of the blocksize ("NB") 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 DTIM22 * * A (workspace) DOUBLE PRECISION array, * dimension( max(NN)*max(LDAS) ) * The original matrix to be tested. * * D (workspace) DOUBLE PRECISION array, * dimension( max(NN) ) * The diagonal of the tridiagonal generated by DSYTRD/TRED1. * * E (workspace) DOUBLE PRECISION array, * dimension( max(NN) ) * The off-diagonal of the tridiagonal generated by * DSYTRD/TRED1. * * E2 (workspace) DOUBLE PRECISION array, * dimension( max(NN) ) * The square of the off-diagonal of the tridiagonal generated * by TRED1. (Used by TQLRAT.) * * Z (workspace) DOUBLE PRECISION array, * dimension( max(NN)*max(LDAS) ) * Various output arrays. * * WORK (workspace) DOUBLE PRECISION array, dimension( LWORK ) * * LWORK (input) INTEGER * Number of elements in WORK. It must be at least * (a) max( (NNB + 2 )*LDAS ) * (b) max( 5*LDAS ) * (c) NSIZES*NTYPES*NPARMS * (d) 2*LDAS + 1 + 3*maxNN + 2*maxNN*log2(maxNN) + 3*maxNN**2 * where maxNN = maximum matrix dimension in NN * log2(x) = smallest integer power of 2 .ge. x * * LLWORK (workspace) LOGICAL array of dimension( NPARMS ), * * IWORK (workspace) INTEGER array of dimension * 6 + 6*maxNN + 5*maxNN*log2(maxNN) * * 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), * NBLOCK=NNB(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), NBLOCK=NNB(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. * * ===================================================================== * * .. Parameters .. INTEGER MAXTYP, NSUBS PARAMETER ( MAXTYP = 4, NSUBS = 23 ) DOUBLE PRECISION ZERO, ONE, TWO PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 ) * .. * .. Local Scalars .. LOGICAL RUNTR1, RUNTRD CHARACTER UPLO INTEGER I, IC, IINFO, IL, ILWORK, IMODE, IN, INFSOK, $ IPAR, ISUB, ITYPE, IU, J, J1, J2, J3, J4, $ LASTL, LDA, LGN, LIWEDC, LIWEVR, LWEDC, LWEVR, $ M, M11, MM, MMM, MTYPES, N, NANSOK, NB, NSPLIT DOUBLE PRECISION ABSTOL, EPS1, RLB, RUB, S1, S2, TIME, ULP, $ ULPINV, UNTIME, VL, VU * .. * .. Local Arrays .. LOGICAL TIMSUB( NSUBS ) CHARACTER*4 PNAMES( 4 ) CHARACTER*9 SUBNAM( NSUBS ) INTEGER IDUMMA( 1 ), INPARM( NSUBS ), IOLDSD( 4 ), $ KMODE( MAXTYP ) * .. * .. External Functions .. INTEGER ILAENV DOUBLE PRECISION DLAMCH, DOPLA, DSECND, DOPLA2 EXTERNAL DLAMCH, DOPLA, DSECND, DOPLA2, ILAENV * .. * .. External Subroutines .. EXTERNAL ATIMIN, BISECT, DCOPY, DLACPY, DLASET, DLATMS, $ DORGTR, DORMTR, DPRTBE, DPTEQR, DSTEBZ, DSTEDC, $ DSTEGR, DSTEIN, DSTEQR, DSTERF, DSYTRD, IMTQL1, $ IMTQL2, TINVIT, TQLRAT, TRED1, TRIDIB, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN * .. * .. Common blocks .. COMMON / LATIME / OPS, ITCNT * .. * .. Scalars in Common .. DOUBLE PRECISION ITCNT, OPS * .. * .. Data statements .. DATA SUBNAM / 'DSYTRD', 'DORGTR', 'DORMTR', $ 'DSTEQR(N)', 'DSTEQR(V)', 'DSTERF', $ 'DPTEQR(N)', 'DPTEQR(V)', 'DSTEBZ(I)', $ 'DSTEBZ(V)', 'DSTEIN', 'DSTEDC(N)', $ 'DSTEDC(I)', 'DSTEDC(V)', 'DSTEGR(N)', $ 'DSTEGR(V)', 'TRED1', 'IMTQL1', 'IMTQL2', $ 'TQLRAT', 'TRIDIB', 'BISECT', 'TINVIT' / DATA INPARM / 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, $ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 / DATA PNAMES / 'LDA', 'NB', 'bad1', 'bad2' / DATA KMODE / 4, 3, 1, 5 / * .. * .. Executable Statements .. * * * Extract the timing request from the input line. * CALL ATIMIN( 'DST', LINE, NSUBS, SUBNAM, TIMSUB, NOUT, INFO ) * * Disable timing of DSTEGR if we're non-IEEE-754 compliant. * NANSOK = ILAENV( 10, 'DSTEGR', ' ', 0, 0, 0, 0 ) INFSOK = ILAENV( 11, 'DSTEGR', ' ', 0, 0, 0, 0 ) IF( NANSOK.NE.1 .OR. INFSOK.NE.1 ) THEN TIMSUB(15) = .FALSE. TIMSUB(16) = .FALSE. END IF * IF( INFO.NE.0 ) $ RETURN * * Check that N <= LDA for the input values. * DO 20 J2 = 1, NSIZES DO 10 J1 = 1, NPARMS IF( NN( J2 ).GT.LDAS( J1 ) ) THEN INFO = -8 WRITE( NOUT, FMT = 9999 )LINE( 1: 6 ) 9999 FORMAT( 1X, A, ' timing run not attempted -- N > LDA', $ / ) RETURN END IF 10 CONTINUE 20 CONTINUE * * Check LWORK * ILWORK = NSIZES*NPARMS*NTYPES DO 30 J1 = 1, NPARMS ILWORK = MAX( ILWORK, 5*LDAS( J1 ), $ ( NNB( J1 )+2 )*LDAS( J1 ) ) 30 CONTINUE IF( ILWORK.GT.LWORK ) THEN INFO = -18 WRITE( NOUT, FMT = 9998 )LINE( 1: 6 ) 9998 FORMAT( 1X, A, ' timing run not attempted -- LWORK too small.', $ / ) RETURN END IF * * Check to see whether DSYTRD must be run. * * RUNTRD -- if DSYTRD must be run. * RUNTRD = .FALSE. IF( TIMSUB( 4 ) .OR. TIMSUB( 5 ) .OR. TIMSUB( 6 ) .OR. $ TIMSUB( 7 ) .OR. TIMSUB( 8 ) .OR. TIMSUB( 9 ) .OR. $ TIMSUB( 10 ) .OR. TIMSUB( 11 ) .OR. TIMSUB( 12 ) .OR. $ TIMSUB( 13 ) .OR. TIMSUB( 14 ) .OR. TIMSUB( 15 ) .OR. $ TIMSUB( 16 ) )RUNTRD = .TRUE. * * Check to see whether TRED1 must be run. * * RUNTR1 -- if TRED1 must be run. * RUNTR1 = .FALSE. IF( TIMSUB( 17 ) .OR. TIMSUB( 18 ) .OR. TIMSUB( 19 ) .OR. $ TIMSUB( 20 ) .OR. TIMSUB( 21 ) .OR. TIMSUB( 22 ) .OR. $ TIMSUB( 23 ) )RUNTR1 = .TRUE. * * Various Constants * ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP CALL XLAENV( 9, 25 ) * * Zero out OPCNTS, TIMES * DO 70 J4 = 1, NSUBS DO 60 J3 = 1, NSIZES DO 50 J2 = 1, NTYPES DO 40 J1 = 1, NPARMS OPCNTS( J1, J2, J3, J4 ) = ZERO TIMES( J1, J2, J3, J4 ) = ZERO 40 CONTINUE 50 CONTINUE 60 CONTINUE 70 CONTINUE * * Do for each value of N: * DO 940 IN = 1, NSIZES * N = NN( IN ) IF( N.GT.0 ) THEN LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) IF( 2**LGN.LT.N ) $ LGN = LGN + 1 IF( 2**LGN.LT.N ) $ LGN = LGN + 1 LWEDC = 1 + 4*N + 2*N*LGN + 3*N**2 LIWEDC = 6 + 6*N + 5*N*LGN LWEVR = 18*N LIWEVR = 10*N ELSE LWEDC = 8 LIWEDC = 12 LWEVR = 1 LIWEVR = 1 END IF * * Do for each .TRUE. value in DOTYPE: * MTYPES = MIN( MAXTYP, NTYPES ) IF( NTYPES.EQ.MAXTYP+1 .AND. NSIZES.EQ.1 ) $ MTYPES = NTYPES DO 930 ITYPE = 1, MTYPES IF( .NOT.DOTYPE( ITYPE ) ) $ GO TO 930 * * Save random number seed for error messages * DO 80 J = 1, 4 IOLDSD( J ) = ISEED( J ) 80 CONTINUE * *----------------------------------------------------------------------- * * Time the LAPACK Routines * * Generate A * UPLO = 'L' IF( ITYPE.LE.MAXTYP ) THEN IMODE = KMODE( ITYPE ) CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, ULPINV, $ ONE, N, N, UPLO, A, N, WORK( N+1 ), IINFO ) END IF * * Time DSYTRD for each pair NNB(j), LDAS(j) * IF( TIMSUB( 1 ) ) THEN DO 110 IPAR = 1, NPARMS LDA = LDAS( IPAR ) NB = MIN( N, NNB( IPAR ) ) CALL XLAENV( 1, NB ) CALL XLAENV( 2, 2 ) CALL XLAENV( 3, NB ) * * Time DSYTRD * IC = 0 OPS = ZERO S1 = DSECND( ) 90 CONTINUE CALL DLACPY( UPLO, N, N, A, N, Z, LDA ) CALL DSYTRD( UPLO, N, Z, LDA, D, E, WORK, WORK( N+1 ), $ LWORK-N, IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 1 ), IINFO, N, $ ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 590 END IF * S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 90 * * Subtract the time used in DLACPY. * S1 = DSECND( ) DO 100 J = 1, IC CALL DLACPY( UPLO, N, N, A, N, Z, LDA ) 100 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 1 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 1 ) = DOPLA( 'DSYTRD', N, 0, $ 0, 0, NB ) 110 CONTINUE ELSE IF( RUNTRD ) THEN CALL DLACPY( UPLO, N, N, A, N, Z, N ) CALL DSYTRD( UPLO, N, Z, N, D, E, WORK, WORK( N+1 ), $ LWORK-N, IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 1 ), IINFO, N, $ ITYPE, 0, IOLDSD INFO = ABS( IINFO ) GO TO 590 END IF END IF END IF * * Time DORGTR for each pair NNB(j), LDAS(j) * IF( TIMSUB( 2 ) ) THEN DO 140 IPAR = 1, NPARMS LDA = LDAS( IPAR ) NB = MIN( N, NNB( IPAR ) ) CALL XLAENV( 1, NB ) CALL XLAENV( 2, 2 ) CALL XLAENV( 3, NB ) * * Time DORGTR * CALL DLACPY( UPLO, N, N, A, N, Z, LDA ) CALL DSYTRD( UPLO, N, Z, LDA, D, E, WORK, WORK( N+1 ), $ LWORK-N, IINFO ) IC = 0 OPS = ZERO S1 = DSECND( ) 120 CONTINUE CALL DLACPY( 'F', N, N, Z, LDA, Z1, LDA ) CALL DORGTR( UPLO, N, Z1, LDA, WORK, WORK( N+1 ), $ LWORK-N, IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 2 ), IINFO, N, $ ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 590 END IF * S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 120 * * Subtract the time used in DLACPY * S1 = DSECND( ) DO 130 J = 1, IC CALL DLACPY( 'F', N, N, Z, LDA, Z1, LDA ) 130 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 2 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 2 ) = DOPLA2( 'DORGTR', UPLO, $ N, N, N, 0, NB ) 140 CONTINUE END IF * * Time DORMTR for each pair NNB(j), LDAS(j) * IF( TIMSUB( 3 ) ) THEN DO 170 IPAR = 1, NPARMS LDA = LDAS( IPAR ) NB = MIN( N, NNB( IPAR ) ) CALL XLAENV( 1, NB ) CALL XLAENV( 2, 2 ) CALL XLAENV( 3, NB ) * * Time DORMTR * CALL DLACPY( UPLO, N, N, A, N, Z, LDA ) CALL DSYTRD( UPLO, N, Z, LDA, D, E, WORK, WORK( N+1 ), $ LWORK-N, IINFO ) IC = 0 OPS = ZERO S1 = DSECND( ) 150 CONTINUE CALL DCOPY( N, D, 1, WORK( LDA+1 ), 1 ) CALL DCOPY( N-1, E, 1, WORK( 2*LDA+1 ), 1 ) CALL DSTEDC( 'N', N, WORK( LDA+1 ), WORK( 2*LDA+1 ), $ Z1, LDA, WORK( 3*LDA+1 ), LWEDC, IWORK, $ LIWEDC, IINFO ) CALL DORMTR( 'L', UPLO, 'N', N, N, Z, LDA, WORK, Z1, $ LDA, WORK( N+1 ), LWORK-N, IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 3 ), IINFO, N, $ ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 590 END IF * S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 150 * * Subtract the time used in DCOPY and DSTEDC * S1 = DSECND( ) DO 160 J = 1, IC CALL DCOPY( N, D, 1, WORK( LDA+1 ), 1 ) CALL DCOPY( N-1, E, 1, WORK( 2*LDA+1 ), 1 ) CALL DSTEDC( 'N', N, WORK( LDA+1 ), $ WORK( 2*LDA+1 ), Z1, LDA, $ WORK( 3*LDA+1 ), LWEDC, IWORK, LIWEDC, $ IINFO ) 160 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 3 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 3 ) = DOPLA2( 'DORMTR', UPLO, $ N, N, N, 0, NB ) 170 CONTINUE END IF * * Time DSTEQR, SSTERF, DPTEQR, SSTEBZ, SSTEIN, SSTEDC, SSTERV * for each distinct LDA=LDAS(j) * IF( TIMSUB( 4 ) .OR. TIMSUB( 5 ) .OR. TIMSUB( 6 ) .OR. $ TIMSUB( 7 ) .OR. TIMSUB( 8 ) .OR. TIMSUB( 9 ) .OR. $ TIMSUB( 10 ) .OR. TIMSUB( 11 ) .OR. TIMSUB( 12 ) .OR. $ TIMSUB( 13 ) .OR. TIMSUB( 14 ) .OR. TIMSUB( 15 ) .OR. $ TIMSUB( 16 ) ) THEN DO 580 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 180 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 180 CONTINUE IF( LASTL.EQ.0 ) THEN * * Time DSTEQR with VECT='N' * IF( TIMSUB( 4 ) ) THEN IC = 0 OPS = ZERO S1 = DSECND( ) 190 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DSTEQR( 'N', N, WORK, WORK( LDA+1 ), Z, $ LDA, WORK( 2*LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 4 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 210 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 190 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 200 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 200 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 4 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 4 ) = OPS / DBLE( IC ) END IF * * Time DSTEQR with VECT='V' * 210 CONTINUE IF( TIMSUB( 5 ) ) THEN IC = 0 OPS = ZERO S1 = DSECND( ) 220 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, LDA ) CALL DSTEQR( 'V', N, WORK, WORK( LDA+1 ), Z, $ LDA, WORK( 2*LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 5 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 240 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 220 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 230 J = 1, IC CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, $ LDA ) CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 230 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 5 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 5 ) = OPS / DBLE( IC ) END IF * * Time DSTERF * 240 CONTINUE IF( TIMSUB( 6 ) ) THEN IC = 0 OPS = ZERO S1 = DSECND( ) 250 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DSTERF( N, WORK, WORK( LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 6 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 270 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 250 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 260 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 260 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 6 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 6 ) = OPS / DBLE( IC ) END IF * * Time DPTEQR with VECT='N' * 270 CONTINUE IF( TIMSUB( 7 ) ) THEN * * Modify the tridiagonal matrix to make it * positive definite. E2( 1 ) = ABS( D( 1 ) ) + ABS( E( 1 ) ) DO 280 I = 2, N - 1 E2( I ) = ABS( D( I ) ) + ABS( E( I ) ) + $ ABS( E( I-1 ) ) 280 CONTINUE E2( N ) = ABS( D( N ) ) + ABS( E( N-1 ) ) IC = 0 OPS = ZERO S1 = DSECND( ) 290 CONTINUE CALL DCOPY( N, E2, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DPTEQR( 'N', N, WORK, WORK( LDA+1 ), Z, $ LDA, WORK( 2*LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 7 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 310 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 290 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 300 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 300 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 7 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 7 ) = OPS / DBLE( IC ) END IF * * Time DPTEQR with VECT='V' * 310 CONTINUE IF( TIMSUB( 8 ) ) THEN * * Modify the tridiagonal matrix to make it * positive definite. E2( 1 ) = ABS( D( 1 ) ) + ABS( E( 1 ) ) DO 320 I = 2, N - 1 E2( I ) = ABS( D( I ) ) + ABS( E( I ) ) + $ ABS( E( I-1 ) ) 320 CONTINUE E2( N ) = ABS( D( N ) ) + ABS( E( N-1 ) ) IC = 0 OPS = ZERO S1 = DSECND( ) 330 CONTINUE CALL DCOPY( N, E2, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DPTEQR( 'V', N, WORK, WORK( LDA+1 ), Z, $ LDA, WORK( 2*LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 8 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 350 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 330 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 340 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 340 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 8 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 8 ) = OPS / DBLE( IC ) END IF * * Time DSTEBZ(I) * 350 CONTINUE IF( TIMSUB( 9 ) ) THEN IL = 1 IU = N ABSTOL = ZERO IC = 0 OPS = ZERO S1 = DSECND( ) 360 CONTINUE CALL DSTEBZ( 'I', 'B', N, VL, VU, IL, IU, $ ABSTOL, D, E, MM, NSPLIT, WORK, $ IWORK, IWORK( LDA+1 ), $ WORK( 2*LDA+1 ), IWORK( 2*LDA+1 ), $ IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 9 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 370 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 360 UNTIME = ZERO * TIMES( IPAR, ITYPE, IN, 9 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 9 ) = OPS / DBLE( IC ) END IF * * Time DSTEBZ(V) * 370 CONTINUE IF( TIMSUB( 10 ) ) THEN IF( N.EQ.1 ) THEN VL = D( 1 ) - ABS( D( 1 ) ) VU = D( 1 ) + ABS( D( 1 ) ) ELSE VL = D( 1 ) - ABS( E( 1 ) ) VU = D( 1 ) + ABS( E( 1 ) ) DO 380 I = 2, N - 1 VL = MIN( VL, D( I )-ABS( E( I ) )- $ ABS( E( I-1 ) ) ) VU = MAX( VU, D( I )+ABS( E( I ) )+ $ ABS( E( I-1 ) ) ) 380 CONTINUE VL = MIN( VL, D( N )-ABS( E( N-1 ) ) ) VU = MAX( VU, D( N )+ABS( E( N-1 ) ) ) END IF ABSTOL = ZERO IC = 0 OPS = ZERO S1 = DSECND( ) 390 CONTINUE CALL DSTEBZ( 'V', 'B', N, VL, VU, IL, IU, $ ABSTOL, D, E, MM, NSPLIT, WORK, $ IWORK, IWORK( LDA+1 ), $ WORK( 2*LDA+1 ), IWORK( 2*LDA+1 ), $ IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 10 ), $ IINFO, N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 400 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 390 UNTIME = ZERO * TIMES( IPAR, ITYPE, IN, 10 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 10 ) = OPS / DBLE( IC ) END IF * * Time DSTEIN * 400 CONTINUE IF( TIMSUB( 11 ) ) THEN IC = 0 OPS = ZERO S1 = DSECND( ) 410 CONTINUE CALL DSTEIN( N, D, E, MM, WORK, IWORK, $ IWORK( LDA+1 ), Z, LDA, $ WORK( LDA+1 ), IWORK( 2*LDA+1 ), $ IWORK( 3*LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 11 ), $ IINFO, N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 420 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 410 UNTIME = ZERO * TIMES( IPAR, ITYPE, IN, 11 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 11 ) = OPS / DBLE( IC ) END IF * * Time DSTEDC with COMPQ='N' * 420 CONTINUE IF( TIMSUB( 12 ) ) THEN IC = 0 OPS = ZERO S1 = DSECND( ) 430 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DSTEDC( 'N', N, WORK, WORK( LDA+1 ), Z, $ LDA, WORK( 2*LDA+1 ), LWEDC, IWORK, $ LIWEDC, IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 12 ), $ IINFO, N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 450 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 430 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 440 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 440 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 12 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 12 ) = OPS / DBLE( IC ) END IF * * Time DSTEDC with COMPQ='I' * 450 CONTINUE IF( TIMSUB( 13 ) ) THEN IC = 0 OPS = ZERO S1 = DSECND( ) 460 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, LDA ) CALL DSTEDC( 'I', N, WORK, WORK( LDA+1 ), Z, $ LDA, WORK( 2*LDA+1 ), LWEDC, IWORK, $ LIWEDC, IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 13 ), $ IINFO, N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 480 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 460 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 470 J = 1, IC CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, $ LDA ) CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 470 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 13 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 13 ) = OPS / DBLE( IC ) END IF 480 CONTINUE * * Time DSTEDC with COMPQ='V' * IF( TIMSUB( 14 ) ) THEN IC = 0 OPS = ZERO S1 = DSECND( ) 490 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, LDA ) CALL DSTEDC( 'V', N, WORK, WORK( LDA+1 ), Z, $ LDA, WORK( 2*LDA+1 ), LWEDC, IWORK, $ LIWEDC, IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 14 ), $ IINFO, N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 510 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 490 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 500 J = 1, IC CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, $ LDA ) CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 500 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 14 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 14 ) = OPS / DBLE( IC ) END IF 510 CONTINUE * * Time DSTEGR with COMPQ='N' * IF( TIMSUB( 15 ) ) THEN ABSTOL = ZERO VL = ZERO VU = ZERO IL = 1 IU = N IC = 0 OPS = ZERO S1 = DSECND( ) 520 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DSTEGR( 'N', 'A', N, WORK, WORK( LDA+1 ), $ VL, VU, IL, IU, ABSTOL, M, $ WORK( 2*LDA+1 ), Z, LDA, IWORK, $ WORK( 3*LDA+1 ), LWEVR, $ IWORK( 2*LDA+1 ), LIWEVR, INFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 15 ), $ IINFO, N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 540 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 520 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 530 J = 1, IC CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, $ LDA ) CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 530 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 15 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 15 ) = OPS / DBLE( IC ) END IF 540 CONTINUE * * Time DSTEGR with COMPQ='V' * IF( TIMSUB( 16 ) ) THEN ABSTOL = ZERO VL = ZERO VU = ZERO IL = 1 IU = N IC = 0 OPS = ZERO S1 = DSECND( ) 550 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DSTEGR( 'V', 'A', N, WORK, WORK( LDA+1 ), $ VL, VU, IL, IU, ABSTOL, M, $ WORK( 2*LDA+1 ), Z, LDA, IWORK, $ WORK( 3*LDA+1 ), LWEVR, $ IWORK( 2*LDA+1 ), LIWEVR, INFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 16 ), $ IINFO, N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 570 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 550 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 560 J = 1, IC CALL DLASET( 'Full', LDA, N, ONE, TWO, Z, $ LDA ) CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 560 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 16 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 16 ) = OPS / DBLE( IC ) END IF 570 CONTINUE * ELSE IF( TIMSUB( 4 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 4 ) = OPCNTS( LASTL, $ ITYPE, IN, 4 ) TIMES( IPAR, ITYPE, IN, 4 ) = TIMES( LASTL, $ ITYPE, IN, 4 ) END IF IF( TIMSUB( 5 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 5 ) = OPCNTS( LASTL, $ ITYPE, IN, 5 ) TIMES( IPAR, ITYPE, IN, 5 ) = TIMES( LASTL, $ ITYPE, IN, 5 ) END IF IF( TIMSUB( 6 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 6 ) = OPCNTS( LASTL, $ ITYPE, IN, 6 ) TIMES( IPAR, ITYPE, IN, 6 ) = TIMES( LASTL, $ ITYPE, IN, 6 ) END IF IF( TIMSUB( 7 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 7 ) = OPCNTS( LASTL, $ ITYPE, IN, 7 ) TIMES( IPAR, ITYPE, IN, 7 ) = TIMES( LASTL, $ ITYPE, IN, 7 ) END IF IF( TIMSUB( 8 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 8 ) = OPCNTS( LASTL, $ ITYPE, IN, 8 ) TIMES( IPAR, ITYPE, IN, 8 ) = TIMES( LASTL, $ ITYPE, IN, 8 ) END IF IF( TIMSUB( 9 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 9 ) = OPCNTS( LASTL, $ ITYPE, IN, 9 ) TIMES( IPAR, ITYPE, IN, 9 ) = TIMES( LASTL, $ ITYPE, IN, 9 ) END IF IF( TIMSUB( 10 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 10 ) = OPCNTS( LASTL, $ ITYPE, IN, 10 ) TIMES( IPAR, ITYPE, IN, 10 ) = TIMES( LASTL, $ ITYPE, IN, 10 ) END IF IF( TIMSUB( 11 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 11 ) = OPCNTS( LASTL, $ ITYPE, IN, 11 ) TIMES( IPAR, ITYPE, IN, 11 ) = TIMES( LASTL, $ ITYPE, IN, 11 ) END IF IF( TIMSUB( 12 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 12 ) = OPCNTS( LASTL, $ ITYPE, IN, 12 ) TIMES( IPAR, ITYPE, IN, 12 ) = TIMES( LASTL, $ ITYPE, IN, 12 ) END IF IF( TIMSUB( 13 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 13 ) = OPCNTS( LASTL, $ ITYPE, IN, 13 ) TIMES( IPAR, ITYPE, IN, 13 ) = TIMES( LASTL, $ ITYPE, IN, 13 ) END IF IF( TIMSUB( 14 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 14 ) = OPCNTS( LASTL, $ ITYPE, IN, 14 ) TIMES( IPAR, ITYPE, IN, 14 ) = TIMES( LASTL, $ ITYPE, IN, 14 ) END IF IF( TIMSUB( 15 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 15 ) = OPCNTS( LASTL, $ ITYPE, IN, 15 ) TIMES( IPAR, ITYPE, IN, 15 ) = TIMES( LASTL, $ ITYPE, IN, 15 ) END IF IF( TIMSUB( 16 ) ) THEN OPCNTS( IPAR, ITYPE, IN, 16 ) = OPCNTS( LASTL, $ ITYPE, IN, 16 ) TIMES( IPAR, ITYPE, IN, 16 ) = TIMES( LASTL, $ ITYPE, IN, 16 ) END IF END IF 580 CONTINUE END IF 590 CONTINUE * *----------------------------------------------------------------------- * * Time the EISPACK Routines * * Skip routines if N <= 0 (EISPACK requirement) * IF( N.LE.0 ) $ GO TO 930 * * Time TRED1 for each LDAS(j) * IF( TIMSUB( 17 ) ) THEN DO 630 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 600 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 600 CONTINUE * IF( LASTL.EQ.0 ) THEN * * Time TRED1 * IC = 0 OPS = ZERO S1 = DSECND( ) 610 CONTINUE CALL DLACPY( 'L', N, N, A, N, Z, LDA ) CALL TRED1( LDA, N, Z, D, E, E2 ) S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 610 * * Subtract the time used in DLACPY. * S1 = DSECND( ) DO 620 J = 1, IC CALL DLACPY( 'L', N, N, A, N, Z, LDA ) 620 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 17 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 17 ) = OPS / DBLE( IC ) ELSE OPCNTS( IPAR, ITYPE, IN, 17 ) = OPCNTS( LASTL, $ ITYPE, IN, 17 ) TIMES( IPAR, ITYPE, IN, 17 ) = TIMES( LASTL, ITYPE, $ IN, 17 ) END IF 630 CONTINUE ELSE IF( RUNTR1 ) THEN CALL DLACPY( 'L', N, N, A, N, Z, LDA ) CALL TRED1( LDA, N, Z, D, E, E2 ) END IF END IF * * Time IMTQL1 for each LDAS(j) * IF( TIMSUB( 18 ) ) THEN DO 670 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 640 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 640 CONTINUE * IF( LASTL.EQ.0 ) THEN * * Time IMTQL1 * IC = 0 OPS = ZERO S1 = DSECND( ) 650 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL IMTQL1( N, WORK, WORK( LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 18 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 680 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 650 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 660 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) 660 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 18 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 18 ) = OPS / DBLE( IC ) ELSE OPCNTS( IPAR, ITYPE, IN, 18 ) = OPCNTS( LASTL, $ ITYPE, IN, 18 ) TIMES( IPAR, ITYPE, IN, 18 ) = TIMES( LASTL, ITYPE, $ IN, 18 ) END IF 670 CONTINUE END IF * * Time IMTQL2 for each LDAS(j) * 680 CONTINUE IF( TIMSUB( 19 ) ) THEN DO 720 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 690 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 690 CONTINUE * IF( LASTL.EQ.0 ) THEN * * Time IMTQL2 * IC = 0 OPS = ZERO S1 = DSECND( ) 700 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DLASET( 'Full', N, N, ONE, TWO, Z, LDA ) CALL IMTQL2( LDA, N, WORK, WORK( LDA+1 ), Z, $ IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 19 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 730 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 700 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 710 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DLASET( 'Full', N, N, ONE, TWO, Z, LDA ) 710 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 19 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 19 ) = OPS / DBLE( IC ) ELSE OPCNTS( IPAR, ITYPE, IN, 19 ) = OPCNTS( LASTL, $ ITYPE, IN, 19 ) TIMES( IPAR, ITYPE, IN, 19 ) = TIMES( LASTL, ITYPE, $ IN, 19 ) END IF 720 CONTINUE END IF * * Time TQLRAT for each LDAS(j) * 730 CONTINUE IF( TIMSUB( 20 ) ) THEN DO 770 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 740 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 740 CONTINUE * IF( LASTL.EQ.0 ) THEN * * Time TQLRAT * IC = 0 OPS = ZERO S1 = DSECND( ) 750 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E2, 1, WORK( LDA+1 ), 1 ) CALL TQLRAT( N, WORK, WORK( LDA+1 ), IINFO ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 20 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 780 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 750 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 760 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E2, 1, WORK( LDA+1 ), 1 ) 760 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 20 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 20 ) = OPS / DBLE( IC ) ELSE OPCNTS( IPAR, ITYPE, IN, 20 ) = OPCNTS( LASTL, $ ITYPE, IN, 20 ) TIMES( IPAR, ITYPE, IN, 20 ) = TIMES( LASTL, ITYPE, $ IN, 20 ) END IF 770 CONTINUE END IF * * Time TRIDIB for each LDAS(j) * 780 CONTINUE IF( TIMSUB( 21 ) ) THEN DO 820 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 790 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 790 CONTINUE * IF( LASTL.EQ.0 ) THEN * * Time TRIDIB * IC = 0 OPS = ZERO EPS1 = ZERO RLB = ZERO RUB = ZERO M11 = 1 MM = N S1 = DSECND( ) 800 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DCOPY( N-1, E2, 1, WORK( 2*LDA+1 ), 1 ) CALL TRIDIB( N, EPS1, WORK( 1 ), WORK( LDA+1 ), $ WORK( 2*LDA+1 ), RLB, RUB, M11, MM, $ WORK( 3*LDA+1 ), IWORK, IINFO, $ WORK( 4*LDA+1 ), WORK( 5*LDA+1 ) ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 21 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 830 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 800 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 810 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N-1, E, 1, WORK( LDA+1 ), 1 ) CALL DCOPY( N-1, E2, 1, WORK( 2*LDA+1 ), 1 ) 810 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 21 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 21 ) = OPS / DBLE( IC ) ELSE OPCNTS( IPAR, ITYPE, IN, 21 ) = OPCNTS( LASTL, $ ITYPE, IN, 21 ) TIMES( IPAR, ITYPE, IN, 21 ) = TIMES( LASTL, ITYPE, $ IN, 21 ) END IF 820 CONTINUE END IF * * Time BISECT for each LDAS(j) * 830 CONTINUE IF( TIMSUB( 22 ) ) THEN DO 880 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 840 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 840 CONTINUE * IF( LASTL.EQ.0 ) THEN * * Time BISECT * VL = D( 1 ) - ABS( E( 2 ) ) VU = D( 1 ) + ABS( E( 2 ) ) DO 850 I = 2, N - 1 VL = MIN( VL, D( I )-ABS( E( I+1 ) )- $ ABS( E( I ) ) ) VU = MAX( VU, D( I )+ABS( E( I+1 ) )+ $ ABS( E( I ) ) ) 850 CONTINUE VL = MIN( VL, D( N )-ABS( E( N ) ) ) VU = MAX( VU, D( N )+ABS( E( N ) ) ) IC = 0 OPS = ZERO EPS1 = ZERO MM = N MMM = 0 S1 = DSECND( ) 860 CONTINUE CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N, E, 1, WORK( LDA+1 ), 1 ) CALL DCOPY( N, E2, 1, WORK( 2*LDA+1 ), 1 ) CALL BISECT( N, EPS1, WORK( 1 ), WORK( LDA+1 ), $ WORK( 2*LDA+1 ), VL, VU, MM, MMM, $ WORK( 3*LDA+1 ), IWORK, IINFO, $ WORK( 4*LDA+1 ), WORK( 5*LDA+1 ) ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 22 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 890 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 860 * * Subtract the time used in DCOPY. * S1 = DSECND( ) DO 870 J = 1, IC CALL DCOPY( N, D, 1, WORK, 1 ) CALL DCOPY( N, E, 1, WORK( LDA+1 ), 1 ) CALL DCOPY( N, E2, 1, WORK( 2*LDA+1 ), 1 ) 870 CONTINUE S2 = DSECND( ) UNTIME = S2 - S1 * TIMES( IPAR, ITYPE, IN, 22 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 22 ) = OPS / DBLE( IC ) ELSE OPCNTS( IPAR, ITYPE, IN, 22 ) = OPCNTS( LASTL, $ ITYPE, IN, 22 ) TIMES( IPAR, ITYPE, IN, 22 ) = TIMES( LASTL, ITYPE, $ IN, 22 ) END IF 880 CONTINUE END IF * * Time TINVIT for each LDAS(j) * 890 CONTINUE IF( TIMSUB( 23 ) ) THEN CALL DCOPY( N, WORK( 3*LDA+1 ), 1, WORK( 1 ), 1 ) DO 920 IPAR = 1, NPARMS LDA = LDAS( IPAR ) * * If this value of LDA has come up before, just use * the value previously computed. * LASTL = 0 DO 900 J = 1, IPAR - 1 IF( LDA.EQ.LDAS( J ) ) $ LASTL = J 900 CONTINUE * IF( LASTL.EQ.0 ) THEN * * Time TINVIT * IC = 0 OPS = ZERO S1 = DSECND( ) 910 CONTINUE CALL TINVIT( LDA, N, D, E, E2, MMM, WORK, IWORK, Z, $ IINFO, WORK( LDA+1 ), WORK( 2*LDA+1 ), $ WORK( 3*LDA+1 ), WORK( 4*LDA+1 ), $ WORK( 5*LDA+1 ) ) IF( IINFO.NE.0 ) THEN WRITE( NOUT, FMT = 9997 )SUBNAM( 23 ), IINFO, $ N, ITYPE, IPAR, IOLDSD INFO = ABS( IINFO ) GO TO 930 END IF S2 = DSECND( ) TIME = S2 - S1 IC = IC + 1 IF( TIME.LT.TIMMIN ) $ GO TO 910 UNTIME = ZERO * TIMES( IPAR, ITYPE, IN, 23 ) = MAX( TIME-UNTIME, $ ZERO ) / DBLE( IC ) OPCNTS( IPAR, ITYPE, IN, 23 ) = OPS / DBLE( IC ) ELSE OPCNTS( IPAR, ITYPE, IN, 23 ) = OPCNTS( LASTL, $ ITYPE, IN, 23 ) TIMES( IPAR, ITYPE, IN, 23 ) = TIMES( LASTL, ITYPE, $ IN, 23 ) END IF 920 CONTINUE END IF * 930 CONTINUE 940 CONTINUE * *----------------------------------------------------------------------- * * Print a table of results for each timed routine. * DO 950 ISUB = 1, NSUBS IF( TIMSUB( ISUB ) ) THEN CALL DPRTBE( SUBNAM( ISUB ), MTYPES, DOTYPE, NSIZES, NN, $ INPARM( ISUB ), PNAMES, NPARMS, LDAS, NNB, $ IDUMMA, IDUMMA, OPCNTS( 1, 1, 1, ISUB ), LDO1, $ LDO2, TIMES( 1, 1, 1, ISUB ), LDT1, LDT2, WORK, $ LLWORK, NOUT ) END IF 950 CONTINUE * 9997 FORMAT( ' DTIM22: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', $ I6, ', ITYPE=', I6, ', IPAR=', I6, ', ISEED=(', $ 3( I5, ',' ), I5, ')' ) * RETURN * * End of DTIM22 * END