1922 lines
72 KiB
FortranFixed
1922 lines
72 KiB
FortranFixed
SUBROUTINE DTIM51( LINE, NSIZES, NN, NTYPES, DOTYPE, NPARMS, NNB,
|
|
$ NSHFTS, NEISPS, MINNBS, MINBKS, LDAS, TIMMIN,
|
|
$ NOUT, ISEED, A, B, H, T, Q, Z, W, WORK, LWORK,
|
|
$ LLWORK, TIMES, LDT1, LDT2, LDT3, OPCNTS, LDO1,
|
|
$ LDO2, LDO3, INFO )
|
|
*
|
|
* -- LAPACK timing routine (version 3.1) --
|
|
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
|
|
* October 2006
|
|
*
|
|
* .. 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( * ), LDAS( * ), MINBKS( * ),
|
|
$ MINNBS( * ), NEISPS( * ), NN( * ), NNB( * ),
|
|
$ NSHFTS( * )
|
|
DOUBLE PRECISION A( * ), B( * ), H( * ),
|
|
$ OPCNTS( LDO1, LDO2, LDO3, * ), Q( * ), T( * ),
|
|
$ TIMES( LDT1, LDT2, LDT3, * ), W( * ),
|
|
$ WORK( * ), Z( * )
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* DTIM51 times the LAPACK routines for the real non-symmetric
|
|
* generalized eigenvalue problem A x = w B x.
|
|
*
|
|
* For each N value in NN(1:NSIZES) and .TRUE. value in
|
|
* DOTYPE(1:NTYPES), a pair of matrices 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
|
|
* The input line which requested this routine. This line may
|
|
* contain a subroutine name, such as DGGHRD, indicating that
|
|
* only routine DGGHRD will be timed, or it may contain a
|
|
* generic name, such as DHG. In this case, the rest of the
|
|
* line is scanned for the first 18 non-blank characters,
|
|
* corresponding to the eighteen combinations of subroutine and
|
|
* options:
|
|
* LAPACK: Table Heading:
|
|
* 1: DGGHRD(no Q, no Z) (+DGEQRF, etc.) 'SGGHRD(N)'
|
|
* 2: DGGHRD(Q only) (+DGEQRF, etc.) 'SGGHRD(Q)'
|
|
* 3: DGGHRD(Z only) (+DGEQRF, etc.) 'SGGHRD(Z)'
|
|
* 4: DGGHRD(Q and Z) (+DGEQRF, etc.) 'SGGHRD(Q,Z)'
|
|
* 5: DHGEQZ(Eigenvalues only) 'SHGEQZ(E)'
|
|
* 6: DHGEQZ(Schur form only) 'SHGEQZ(S)'
|
|
* 7: DHGEQZ(Schur form and Q) 'SHGEQZ(Q)'
|
|
* 8: DHGEQZ(Schur form and Z) 'SHGEQZ(Z)'
|
|
* 9: DHGEQZ(Schur form, Q and Z) 'SHGEQZ(Q,Z)'
|
|
* 10: DTGEVC(SIDE='L', HOWMNY='A') 'STGEVC(L,A)'
|
|
* 11: DTGEVC(SIDE='L', HOWMNY='B') 'STGEVC(L,B)'
|
|
* 12: DTGEVC(SIDE='R', HOWMNY='A') 'STGEVC(R,A)'
|
|
* 13: DTGEVC(SIDE='R', HOWMNY='B') 'STGEVC(R,B)'
|
|
* EISPACK: Compare w/: Table Heading:
|
|
* 14: QZHES w/ matz=.false. 1 'QZHES(F)'
|
|
* 15: QZHES w/ matz=.true. 3 'QZHES(T)'
|
|
* 16: QZIT and QZVAL w/ matz=.false. 5 'QZIT(F)'
|
|
* 17: QZIT and QZVAL w/ matz=.true. 8 'QZIT(T)'
|
|
* 18: QZVEC 13 'QZVEC'
|
|
* 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.
|
|
*
|
|
* Note that since QZHES does more than DGGHRD, the
|
|
* "DGGHRD" timing also includes the time for the calls
|
|
* to DGEQRF, DORMQR, and (if Q is computed) DORGQR
|
|
* which are necessary to get the same functionality
|
|
* as QZHES.
|
|
*
|
|
* 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 pair of matrices (A,B) of
|
|
* type j will be generated. A and B have the form U T1 V
|
|
* and U T2 V , resp., where U and V are orthogonal, T1 is
|
|
* block upper triangular (with 1x1 and 2x2 diagonal blocks),
|
|
* and T2 is upper triangular. T2 has random O(1) entries in
|
|
* the strict upper triangle and ( 0, 1, 0, 1, 1, ..., 1, 0 )
|
|
* on the diagonal, while T1 has random O(1) entries in the
|
|
* strict (block) upper triangle, its block diagonal will have
|
|
* the singular values:
|
|
* (j=1) 0, 0, 1, 1, ULP,..., ULP, 0.
|
|
* (j=2) 0, 0, 1, 1, 1-d, 1-2*d, ..., 1-(N-5)*d=ULP, 0.
|
|
*
|
|
* 2 N-5
|
|
* (j=3) 0, 0, 1, 1, a, a , ..., a =ULP, 0.
|
|
* (j=4) 0, 0, 1, r1, r2, ..., r(N-4), 0, where r1, etc.
|
|
* are random numbers in (ULP,1).
|
|
*
|
|
* NPARMS (input) INTEGER
|
|
* The number of values in each of the arrays NNB, NSHFTS,
|
|
* NEISPS, and LDAS. For each matrix A generated according to
|
|
* NN and DOTYPE, tests will be run with (NB,NSHIFT,NEISP,LDA)=
|
|
* (NNB(1), NSHFTS(1), NEISPS(1), LDAS(1)),...,
|
|
* (NNB(NPARMS), NSHFTS(NPARMS), NEISPS(NPARMS), LDAS(NPARMS))
|
|
*
|
|
* NNB (input) INTEGER array, dimension (NPARMS)
|
|
* The values of the blocksize ("NB") to be tested. They must
|
|
* be at least 1. Currently, this is only used by DGEQRF,
|
|
* etc., in the timing of DGGHRD.
|
|
*
|
|
* NSHFTS (input) INTEGER array, dimension (NPARMS)
|
|
* The values of the number of shifts ("NSHIFT") to be tested.
|
|
* (Currently not used.)
|
|
*
|
|
* NEISPS (input) INTEGER array, dimension (NPARMS)
|
|
* The values of "NEISP", the size of largest submatrix to be
|
|
* processed by DLAEQZ (EISPACK method), to be tested.
|
|
* (Currently not used.)
|
|
*
|
|
* MINNBS (input) INTEGER array, dimension (NPARMS)
|
|
* The values of "MINNB", the minimum size of a product of
|
|
* transformations which may be applied as a blocked
|
|
* transformation, to be tested. (Currently not used.)
|
|
*
|
|
* MINBKS (input) INTEGER array, dimension (NPARMS)
|
|
* The values of "MINBK", the minimum number of rows/columns
|
|
* to be updated with a blocked transformation, to be tested.
|
|
* (Currently not used.)
|
|
*
|
|
* 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 DTIM51
|
|
*
|
|
* A (workspace) DOUBLE PRECISION array, dimension
|
|
* (max(NN)*max(LDAS))
|
|
* (a) During the testing of DGGHRD, "A", the original
|
|
* left-hand-side matrix to be tested.
|
|
* (b) Later, "S", the Schur form of the original "A" matrix.
|
|
*
|
|
* B (workspace) DOUBLE PRECISION array, dimension
|
|
* (max(NN)*max(LDAS))
|
|
* (a) During the testing of DGGHRD, "B", the original
|
|
* right-hand-side matrix to be tested.
|
|
* (b) Later, "P", the Schur form of the original "B" matrix.
|
|
*
|
|
* H (workspace) DOUBLE PRECISION array, dimension
|
|
* (max(NN)*max(LDAS))
|
|
* (a) During the testing of DGGHRD and DHGEQZ, "H", the
|
|
* Hessenberg form of the original "A" matrix.
|
|
* (b) During the testing of DTGEVC, "L", the matrix of left
|
|
* eigenvectors.
|
|
*
|
|
* T (workspace) DOUBLE PRECISION array, dimension
|
|
* (max(NN)*max(LDAS))
|
|
* (a) During the testing of DGGHRD and DHGEQZ, "T", the
|
|
* triangular form of the original "B" matrix.
|
|
* (b) During the testing of DTGEVC, "R", the matrix of right
|
|
* eigenvectors.
|
|
*
|
|
* Q (workspace) DOUBLE PRECISION array, dimension
|
|
* (max(NN)*max(LDAS))
|
|
* The orthogonal matrix on the left generated by DGGHRD. If
|
|
* DHGEQZ computes only Q or Z, then that matrix is stored here.
|
|
* If both Q and Z are computed, the Q matrix goes here.
|
|
*
|
|
* Z (workspace) DOUBLE PRECISION array, dimension
|
|
* (max(NN)*max(LDAS))
|
|
* The orthogonal matrix on the right generated by DGGHRD.
|
|
* If DHGEQZ computes both Q and Z, the Z matrix is stored here.
|
|
* Also used as scratch space for timing the DLACPY calls.
|
|
*
|
|
* W (workspace) DOUBLE PRECISION array, dimension (3*max(LDAS))
|
|
* Treated as an LDA x 3 matrix whose 1st and 2nd columns hold
|
|
* ALPHAR and ALPHAI, the real and imaginary parts of the
|
|
* diagonal entries of "S" that would result from reducing "S"
|
|
* and "P" simultaneously to triangular form), and whose 3rd
|
|
* column holds BETA, the diagonal entries of "P" that would so
|
|
* result.
|
|
*
|
|
* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
|
|
*
|
|
* LWORK (input) INTEGER
|
|
* Number of elements in WORK. It must be at least
|
|
* (a) 6*max(NN)
|
|
* (b) NSIZES*NTYPES*NPARMS
|
|
*
|
|
* LLWORK (workspace) LOGICAL array, dimension (max( max(NN), NPARMS ))
|
|
*
|
|
* 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),
|
|
* NEISP=NEISPS(i), NBLOCK=NNB(i), NSHIFT=NSHFTS(i),
|
|
* MINNB=MINNBS(i), and MINBLK=MINBKS(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), NEISP=NEISPS(i), NBLOCK=NNB(i),
|
|
* NSHIFT=NSHFTS(i), MINNB=MINNBS(i), and MINBLK=MINBKS(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 = 18 )
|
|
DOUBLE PRECISION ZERO, ONE
|
|
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
LOGICAL RUNEQ, RUNES, RUNHES, RUNHRD, RUNQZ
|
|
INTEGER IC, IINFO, IN, IPAR, ISUB, ITEMP, ITYPE, J, J1,
|
|
$ J2, J3, J4, JC, JR, LASTL, LDA, LDAMIN, LDH,
|
|
$ LDQ, LDS, LDW, MINBLK, MINNB, MTYPES, N, N1,
|
|
$ NB, NBSMAX, NEISP, NMAX, NSHIFT
|
|
DOUBLE PRECISION S1, S2, TIME, ULP, UNTIME
|
|
* ..
|
|
* .. Local Arrays ..
|
|
LOGICAL TIMSUB( NSUBS )
|
|
CHARACTER(32) PNAMES( 6 )
|
|
CHARACTER*11 SUBNAM( NSUBS )
|
|
INTEGER INPARM( NSUBS ), IOLDSD( 4 ), KATYPE( MAXTYP )
|
|
* ..
|
|
* .. External Functions ..
|
|
INTEGER ILA_LEN_TRIM
|
|
EXTERNAL ILA_LEN_TRIM
|
|
DOUBLE PRECISION DLAMCH, DLARND, DOPLA, DSECND
|
|
EXTERNAL DLAMCH, DLARND, DOPLA, DSECND
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL ATIMIN, DHGEQZ, DLACPY, DLAQZH, DLARFG, DLASET,
|
|
$ DLATM4, DORM2R, DPRTBG, DTGEVC, QZHES, QZIT,
|
|
$ QZVAL, QZVEC, XLAENV
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC ABS, DBLE, MAX, MIN, SIGN
|
|
* ..
|
|
* .. Common blocks ..
|
|
COMMON / LATIME / OPS, ITCNT
|
|
* ..
|
|
* .. Scalars in Common ..
|
|
DOUBLE PRECISION ITCNT, OPS
|
|
* ..
|
|
* .. Data statements ..
|
|
DATA SUBNAM / 'DGGHRD(N)', 'DGGHRD(Q)', 'DGGHRD(Z)',
|
|
$ 'DGGHRD(Q,Z)', 'DHGEQZ(E)', 'DHGEQZ(S)',
|
|
$ 'DHGEQZ(Q)', 'DHGEQZ(Z)', 'DHGEQZ(Q,Z)',
|
|
$ 'DTGEVC(L,A)', 'DTGEVC(L,B)', 'DTGEVC(R,A)',
|
|
$ 'DTGEVC(R,B)', 'QZHES(F)', 'QZHES(T)',
|
|
$ 'QZIT(F)', 'QZIT(T)', 'QZVEC' /
|
|
DATA INPARM / 4*2, 5*1, 4*1, 5*1 /
|
|
DATA PNAMES / ' LDA', ' NB', ' NS',
|
|
$ ' NEISP', ' MINNB', 'MINBLK' /
|
|
DATA KATYPE / 5, 8, 7, 9 /
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
* Quick Return
|
|
*
|
|
INFO = 0
|
|
IF( NSIZES.LE.0 .OR. NTYPES.LE.0 .OR. NPARMS.LE.0 )
|
|
$ RETURN
|
|
*
|
|
* Extract the timing request from the input line.
|
|
*
|
|
CALL ATIMIN( 'DHG', LINE, NSUBS, SUBNAM, TIMSUB, NOUT, INFO )
|
|
IF( INFO.NE.0 )
|
|
$ RETURN
|
|
*
|
|
* Compute Maximum Values
|
|
*
|
|
NMAX = 0
|
|
DO 10 J1 = 1, NSIZES
|
|
NMAX = MAX( NMAX, NN( J1 ) )
|
|
10 CONTINUE
|
|
*
|
|
LDAMIN = 2*MAX( 1, NMAX )
|
|
NBSMAX = 0
|
|
DO 20 J1 = 1, NPARMS
|
|
LDAMIN = MIN( LDAMIN, LDAS( J1 ) )
|
|
NBSMAX = MAX( NBSMAX, NNB( J1 )+NSHFTS( J1 ) )
|
|
20 CONTINUE
|
|
*
|
|
* Check that N <= LDA for the input values.
|
|
*
|
|
IF( NMAX.GT.LDAMIN ) THEN
|
|
INFO = -12
|
|
WRITE( NOUT, FMT = 9999 )LINE( 1: 6 )
|
|
9999 FORMAT( 1X, A, ' timing run not attempted -- N > LDA', / )
|
|
RETURN
|
|
END IF
|
|
*
|
|
* Check LWORK
|
|
*
|
|
IF( LWORK.LT.MAX( ( NBSMAX+1 )*( 2*NBSMAX+NMAX+1 ), 6*NMAX,
|
|
$ NSIZES*NTYPES*NPARMS ) ) THEN
|
|
INFO = -24
|
|
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 DGGHRD or DHGEQZ must be run.
|
|
* RUNHRD -- if DGGHRD must be run.
|
|
* RUNES -- if DHGEQZ must be run to get Schur form.
|
|
* RUNEQ -- if DHGEQZ must be run to get Schur form and Q.
|
|
*
|
|
RUNHRD = .FALSE.
|
|
RUNES = .FALSE.
|
|
RUNEQ = .FALSE.
|
|
*
|
|
IF( TIMSUB( 10 ) .OR. TIMSUB( 12 ) )
|
|
$ RUNES = .TRUE.
|
|
IF( TIMSUB( 11 ) .OR. TIMSUB( 13 ) )
|
|
$ RUNEQ = .TRUE.
|
|
IF( TIMSUB( 5 ) .OR. TIMSUB( 6 ) .OR. TIMSUB( 7 ) .OR.
|
|
$ TIMSUB( 8 ) .OR. TIMSUB( 9 ) .OR. RUNES .OR. RUNEQ )
|
|
$ RUNHRD = .TRUE.
|
|
*
|
|
IF( TIMSUB( 6 ) .OR. TIMSUB( 7 ) .OR. TIMSUB( 8 ) .OR.
|
|
$ TIMSUB( 9 ) .OR. RUNEQ )RUNES = .FALSE.
|
|
IF( TIMSUB( 7 ) .OR. TIMSUB( 8 ) .OR. TIMSUB( 9 ) )
|
|
$ RUNEQ = .FALSE.
|
|
IF( TIMSUB( 1 ) .OR. TIMSUB( 2 ) .OR. TIMSUB( 3 ) .OR.
|
|
$ TIMSUB( 4 ) )RUNHRD = .FALSE.
|
|
*
|
|
* Check to see whether QZHES or QZIT must be run.
|
|
*
|
|
* RUNHES -- if QZHES must be run.
|
|
* RUNQZ -- if QZIT and QZVAL must be run (w/ MATZ=.TRUE.).
|
|
*
|
|
RUNHES = .FALSE.
|
|
RUNQZ = .FALSE.
|
|
*
|
|
IF( TIMSUB( 18 ) )
|
|
$ RUNQZ = .TRUE.
|
|
IF( TIMSUB( 16 ) .OR. TIMSUB( 17 ) .OR. RUNQZ )
|
|
$ RUNHES = .TRUE.
|
|
IF( TIMSUB( 17 ) )
|
|
$ RUNQZ = .FALSE.
|
|
IF( TIMSUB( 14 ) .OR. TIMSUB( 15 ) )
|
|
$ RUNHES = .FALSE.
|
|
*
|
|
* Various Constants
|
|
*
|
|
ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
|
|
*
|
|
* Zero out OPCNTS, TIMES
|
|
*
|
|
DO 60 J4 = 1, NSUBS
|
|
DO 50 J3 = 1, NSIZES
|
|
DO 40 J2 = 1, NTYPES
|
|
DO 30 J1 = 1, NPARMS
|
|
OPCNTS( J1, J2, J3, J4 ) = ZERO
|
|
TIMES( J1, J2, J3, J4 ) = ZERO
|
|
30 CONTINUE
|
|
40 CONTINUE
|
|
50 CONTINUE
|
|
60 CONTINUE
|
|
*
|
|
* Do for each value of N:
|
|
*
|
|
DO 930 IN = 1, NSIZES
|
|
*
|
|
N = NN( IN )
|
|
N1 = MAX( 1, N )
|
|
*
|
|
* Do for each .TRUE. value in DOTYPE:
|
|
*
|
|
MTYPES = MIN( MAXTYP, NTYPES )
|
|
IF( NTYPES.EQ.MAXTYP+1 .AND. NSIZES.EQ.1 )
|
|
$ MTYPES = NTYPES
|
|
DO 920 ITYPE = 1, MTYPES
|
|
IF( .NOT.DOTYPE( ITYPE ) )
|
|
$ GO TO 920
|
|
*
|
|
* Save random number seed for error messages
|
|
*
|
|
DO 70 J = 1, 4
|
|
IOLDSD( J ) = ISEED( J )
|
|
70 CONTINUE
|
|
*
|
|
* Time the LAPACK Routines
|
|
*
|
|
* Generate A and B
|
|
*
|
|
IF( ITYPE.LE.MAXTYP ) THEN
|
|
*
|
|
* Generate A (w/o rotation)
|
|
*
|
|
CALL DLATM4( KATYPE( ITYPE ), N, 3, 1, 2, ONE, ULP, ONE,
|
|
$ 2, ISEED, A, N1 )
|
|
IF( 3.LE.N )
|
|
$ A( 3+2*N1 ) = ONE
|
|
*
|
|
* Generate B (w/o rotation)
|
|
*
|
|
CALL DLATM4( 8, N, 3, 1, 0, ONE, ONE, ONE, 2, ISEED, B,
|
|
$ N1 )
|
|
IF( 2.LE.N )
|
|
$ B( 2+N1 ) = ONE
|
|
*
|
|
IF( N.GT.0 ) THEN
|
|
*
|
|
* Include rotations
|
|
*
|
|
* Generate U, V as Householder transformations times
|
|
* a diagonal matrix.
|
|
*
|
|
DO 90 JC = 1, N - 1
|
|
IC = ( JC-1 )*N1
|
|
DO 80 JR = JC, N
|
|
Q( JR+IC ) = DLARND( 3, ISEED )
|
|
Z( JR+IC ) = DLARND( 3, ISEED )
|
|
80 CONTINUE
|
|
CALL DLARFG( N+1-JC, Q( JC+IC ), Q( JC+1+IC ), 1,
|
|
$ WORK( JC ) )
|
|
WORK( 2*N+JC ) = SIGN( ONE, Q( JC+IC ) )
|
|
Q( JC+IC ) = ONE
|
|
CALL DLARFG( N+1-JC, Z( JC+IC ), Z( JC+1+IC ), 1,
|
|
$ WORK( N+JC ) )
|
|
WORK( 3*N+JC ) = SIGN( ONE, Z( JC+IC ) )
|
|
Z( JC+IC ) = ONE
|
|
90 CONTINUE
|
|
IC = ( N-1 )*N1
|
|
Q( N+IC ) = ONE
|
|
WORK( N ) = ZERO
|
|
WORK( 3*N ) = SIGN( ONE, DLARND( 2, ISEED ) )
|
|
Z( N+IC ) = ONE
|
|
WORK( 2*N ) = ZERO
|
|
WORK( 4*N ) = SIGN( ONE, DLARND( 2, ISEED ) )
|
|
*
|
|
* Apply the diagonal matrices
|
|
*
|
|
DO 110 JC = 1, N
|
|
DO 100 JR = 1, N
|
|
A( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
|
|
$ A( JR+IC )
|
|
B( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
|
|
$ B( JR+IC )
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
CALL DORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, A, N1,
|
|
$ WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 120
|
|
CALL DORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
|
|
$ A, N1, WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 120
|
|
CALL DORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, B, N1,
|
|
$ WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 120
|
|
CALL DORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
|
|
$ B, N1, WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 120
|
|
END IF
|
|
120 CONTINUE
|
|
END IF
|
|
*
|
|
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
*
|
|
* Time DGGHRD
|
|
*
|
|
* Time DGEQRF+DGGHRD('N','N',...) for each pair
|
|
* (LDAS(j),NNB(j))
|
|
*
|
|
IF( TIMSUB( 1 ) ) THEN
|
|
DO 160 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
NB = NNB( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 1 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 1 ) = ZERO
|
|
GO TO 160
|
|
END IF
|
|
*
|
|
* If this value of (NB,LDA) has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 130 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
|
|
$ LASTL = J
|
|
130 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DGGHRD, computing neither Q nor Z
|
|
* (Actually, time DGEQRF + DORMQR + DGGHRD.)
|
|
*
|
|
CALL XLAENV( 1, NB )
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
140 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, LDA )
|
|
CALL DLAQZH( .FALSE., .FALSE., N, 1, N, H, LDA, T,
|
|
$ LDA, Q, LDA, Z, LDA, WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 1 )(1:ILA_LEN_TRIM( SUBNAM( 1 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
*
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 140
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 150 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, A, N1, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, Z, LDA )
|
|
150 CONTINUE
|
|
S2 = DSECND( )
|
|
UNTIME = S2 - S1
|
|
*
|
|
TIMES( IPAR, ITYPE, IN, 1 ) = MAX( TIME-UNTIME,
|
|
$ ZERO ) / DBLE( IC )
|
|
OPCNTS( IPAR, ITYPE, IN, 1 ) = OPS / DBLE( IC ) +
|
|
$ DOPLA( 'DGEQRF', N, N, 0, 0, NB ) +
|
|
$ DOPLA( 'DORMQR', N, N, 0, 0, NB )
|
|
LDH = LDA
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 1 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 1 )
|
|
TIMES( IPAR, ITYPE, IN, 1 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 1 )
|
|
END IF
|
|
160 CONTINUE
|
|
ELSE IF( RUNHRD ) THEN
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, N1 )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, N1 )
|
|
CALL DLAQZH( .FALSE., .FALSE., N, 1, N, H, N1, T, N1, Q,
|
|
$ N1, Z, N1, WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 1 )(1:ILA_LEN_TRIM( SUBNAM( 1 ) )), IINFO, N,
|
|
$ ITYPE, 0, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
LDH = N
|
|
END IF
|
|
*
|
|
* Time DGGHRD('I','N',...) for each pair (LDAS(j),NNB(j))
|
|
*
|
|
IF( TIMSUB( 2 ) ) THEN
|
|
DO 200 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
NB = NNB( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 2 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 2 ) = ZERO
|
|
GO TO 200
|
|
END IF
|
|
*
|
|
* If this value of (NB,LDA) has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 170 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
|
|
$ LASTL = J
|
|
170 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DGGHRD, computing Q but not Z
|
|
* (Actually, DGEQRF + DORMQR + DORGQR + DGGHRD.)
|
|
*
|
|
CALL XLAENV( 1, NB )
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
180 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, LDA )
|
|
CALL DLAQZH( .TRUE., .FALSE., N, 1, N, H, LDA, T,
|
|
$ LDA, Q, LDA, Z, LDA, WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 2 )(1:ILA_LEN_TRIM( SUBNAM( 2 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
*
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 180
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 190 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, A, N1, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, Z, LDA )
|
|
190 CONTINUE
|
|
S2 = DSECND( )
|
|
UNTIME = S2 - S1
|
|
*
|
|
TIMES( IPAR, ITYPE, IN, 2 ) = MAX( TIME-UNTIME,
|
|
$ ZERO ) / DBLE( IC )
|
|
OPCNTS( IPAR, ITYPE, IN, 2 ) = OPS / DBLE( IC ) +
|
|
$ DOPLA( 'DGEQRF', N, N, 0, 0, NB ) +
|
|
$ DOPLA( 'DORMQR', N, N, 0, 0, NB ) +
|
|
$ DOPLA( 'DORGQR', N, N, 0, 0, NB )
|
|
LDH = LDA
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 2 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 2 )
|
|
TIMES( IPAR, ITYPE, IN, 2 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 2 )
|
|
END IF
|
|
200 CONTINUE
|
|
END IF
|
|
*
|
|
* Time DGGHRD('N','I',...) for each pair (LDAS(j),NNB(j))
|
|
*
|
|
IF( TIMSUB( 3 ) ) THEN
|
|
DO 240 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
NB = NNB( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 3 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 3 ) = ZERO
|
|
GO TO 240
|
|
END IF
|
|
*
|
|
* If this value of (NB,LDA) has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 210 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
|
|
$ LASTL = J
|
|
210 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DGGHRD, computing Z but not Q
|
|
* (Actually, DGEQRF + DORMQR + DGGHRD.)
|
|
*
|
|
CALL XLAENV( 1, NB )
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
220 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, LDA )
|
|
CALL DLAQZH( .FALSE., .TRUE., N, 1, N, H, LDA, T,
|
|
$ LDA, Q, LDA, Z, LDA, WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 3 )(1:ILA_LEN_TRIM( SUBNAM( 3 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
*
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 220
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 230 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, A, N1, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, Z, LDA )
|
|
230 CONTINUE
|
|
S2 = DSECND( )
|
|
UNTIME = S2 - S1
|
|
*
|
|
TIMES( IPAR, ITYPE, IN, 3 ) = MAX( TIME-UNTIME,
|
|
$ ZERO ) / DBLE( IC )
|
|
OPCNTS( IPAR, ITYPE, IN, 3 ) = OPS / DBLE( IC ) +
|
|
$ DOPLA( 'DGEQRF', N, N, 0, 0, NB ) +
|
|
$ DOPLA( 'DORMQR', N, N, 0, 0, NB )
|
|
LDH = LDA
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 3 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 3 )
|
|
TIMES( IPAR, ITYPE, IN, 3 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 3 )
|
|
END IF
|
|
240 CONTINUE
|
|
END IF
|
|
*
|
|
* Time DGGHRD('I','I',...) for each pair (LDAS(j),NNB(j))
|
|
*
|
|
IF( TIMSUB( 4 ) ) THEN
|
|
DO 280 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
NB = NNB( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 4 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 4 ) = ZERO
|
|
GO TO 280
|
|
END IF
|
|
*
|
|
* If this value of (NB,LDA) has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 250 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
|
|
$ LASTL = J
|
|
250 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DGGHRD, computing Q and Z
|
|
* (Actually, DGEQRF + DORMQR + DORGQR + DGGHRD.)
|
|
*
|
|
CALL XLAENV( 1, NB )
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
260 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, LDA )
|
|
CALL DLAQZH( .TRUE., .TRUE., N, 1, N, H, LDA, T,
|
|
$ LDA, Q, LDA, Z, LDA, WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 4 )(1:ILA_LEN_TRIM( SUBNAM( 4 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
*
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 260
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 270 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, A, N1, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, Z, LDA )
|
|
270 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 ) +
|
|
$ DOPLA( 'DGEQRF', N, N, 0, 0, NB ) +
|
|
$ DOPLA( 'DORMQR', N, N, 0, 0, NB ) +
|
|
$ DOPLA( 'DORGQR', N, N, 0, 0, NB )
|
|
LDH = LDA
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 4 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 4 )
|
|
TIMES( IPAR, ITYPE, IN, 4 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 4 )
|
|
END IF
|
|
280 CONTINUE
|
|
END IF
|
|
*
|
|
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
*
|
|
* Time DHGEQZ
|
|
*
|
|
* Time DHGEQZ with JOB='E' for each value of LDAS(j)
|
|
*
|
|
IF( TIMSUB( 5 ) ) THEN
|
|
DO 320 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 5 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 5 ) = ZERO
|
|
GO TO 320
|
|
END IF
|
|
*
|
|
* If this value of LDA has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 290 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
290 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DHGEQZ with JOB='E'
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
300 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, LDA )
|
|
CALL DHGEQZ( 'E', 'N', 'N', N, 1, N, A, LDA, B,
|
|
$ LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
|
|
$ LDA, Z, LDA, WORK, LWORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 5 )(1:ILA_LEN_TRIM( SUBNAM( 5 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 300
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 310 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, H, LDH, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, Z, LDA )
|
|
310 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 )
|
|
LDS = 0
|
|
LDQ = 0
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 5 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 5 )
|
|
TIMES( IPAR, ITYPE, IN, 5 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 5 )
|
|
END IF
|
|
320 CONTINUE
|
|
END IF
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ=COMPZ='N' for each value
|
|
* of LDAS(j)
|
|
*
|
|
IF( TIMSUB( 6 ) ) THEN
|
|
DO 360 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 6 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 6 ) = ZERO
|
|
GO TO 360
|
|
END IF
|
|
*
|
|
* If this value of LDA has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 330 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
330 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ=COMPZ='N'
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
340 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, LDA )
|
|
CALL DHGEQZ( 'S', 'N', 'N', N, 1, N, A, LDA, B,
|
|
$ LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
|
|
$ LDA, Z, LDA, WORK, LWORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 6 )(1:ILA_LEN_TRIM( SUBNAM( 6 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 340
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 350 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, H, LDH, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, Z, LDA )
|
|
350 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 )
|
|
LDS = LDA
|
|
LDQ = 0
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 6 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 6 )
|
|
TIMES( IPAR, ITYPE, IN, 6 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 6 )
|
|
END IF
|
|
360 CONTINUE
|
|
ELSE IF( RUNES ) THEN
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, N1 )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, N1 )
|
|
CALL DHGEQZ( 'S', 'N', 'N', N, 1, N, A, N1, B, N1, W,
|
|
$ W( N1+1 ), W( 2*N1+1 ), Q, N1, Z, N1, WORK,
|
|
$ LWORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 6 )(1:ILA_LEN_TRIM( SUBNAM( 6 ) )), IINFO, N,
|
|
$ ITYPE, 0, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
LDS = N1
|
|
LDQ = 0
|
|
END IF
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ='I', COMPZ='N' for each
|
|
* value of LDAS(j)
|
|
*
|
|
IF( TIMSUB( 7 ) ) THEN
|
|
DO 400 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 7 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 7 ) = ZERO
|
|
GO TO 400
|
|
END IF
|
|
*
|
|
* If this value of LDA has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 370 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
370 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ='I', COMPZ='N'
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
380 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, LDA )
|
|
CALL DHGEQZ( 'S', 'I', 'N', N, 1, N, A, LDA, B,
|
|
$ LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
|
|
$ LDA, Z, LDA, WORK, LWORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 7 )(1:ILA_LEN_TRIM( SUBNAM( 7 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 380
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 390 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, H, LDH, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, Z, LDA )
|
|
390 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 )
|
|
LDS = LDA
|
|
LDQ = LDA
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 7 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 7 )
|
|
TIMES( IPAR, ITYPE, IN, 7 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 7 )
|
|
END IF
|
|
400 CONTINUE
|
|
ELSE IF( RUNEQ ) THEN
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, N1 )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, N1 )
|
|
CALL DHGEQZ( 'S', 'I', 'N', N, 1, N, A, N1, B, N1, W,
|
|
$ W( N1+1 ), W( 2*N1+1 ), Q, N1, Z, N1, WORK,
|
|
$ LWORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 7 )(1:ILA_LEN_TRIM( SUBNAM( 7 ) )), IINFO, N,
|
|
$ ITYPE, 0, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
LDS = N1
|
|
LDQ = N1
|
|
END IF
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ='N', COMPZ='I' for each
|
|
* value of LDAS(j)
|
|
*
|
|
IF( TIMSUB( 8 ) ) THEN
|
|
DO 440 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 8 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 8 ) = ZERO
|
|
GO TO 440
|
|
END IF
|
|
*
|
|
* If this value of LDA has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 410 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
410 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
NB = MIN( N, NNB( IPAR ) )
|
|
NSHIFT = NSHFTS( IPAR )
|
|
NEISP = NEISPS( IPAR )
|
|
MINNB = MINNBS( IPAR )
|
|
MINBLK = MINBKS( IPAR )
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ='N', COMPZ='I'
|
|
* (Note that the "Z" matrix is stored in the array Q)
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
420 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, LDA )
|
|
CALL DHGEQZ( 'S', 'N', 'I', N, 1, N, A, LDA, B,
|
|
$ LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Z,
|
|
$ LDA, Q, LDA, WORK, LWORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 8 )(1:ILA_LEN_TRIM( SUBNAM( 8 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 420
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 430 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, H, LDH, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, Z, LDA )
|
|
430 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 )
|
|
LDS = LDA
|
|
LDQ = LDA
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 8 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 8 )
|
|
TIMES( IPAR, ITYPE, IN, 8 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 8 )
|
|
END IF
|
|
440 CONTINUE
|
|
END IF
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ='I', COMPZ='I' for each
|
|
* value of LDAS(j)
|
|
*
|
|
IF( TIMSUB( 9 ) ) THEN
|
|
DO 480 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 9 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 9 ) = ZERO
|
|
GO TO 480
|
|
END IF
|
|
*
|
|
* If this value of LDA has occurred before,
|
|
* just use that value.
|
|
*
|
|
LASTL = 0
|
|
DO 450 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
450 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time DHGEQZ with JOB='S', COMPQ='I', COMPZ='I'
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
460 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, LDA )
|
|
CALL DHGEQZ( 'S', 'I', 'I', N, 1, N, A, LDA, B,
|
|
$ LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
|
|
$ LDA, Z, LDA, WORK, LWORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 9 )(1:ILA_LEN_TRIM( SUBNAM( 9 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 460
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 470 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, H, LDH, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, Z, LDA )
|
|
470 CONTINUE
|
|
S2 = DSECND( )
|
|
UNTIME = S2 - S1
|
|
*
|
|
TIMES( IPAR, ITYPE, IN, 9 ) = MAX( TIME-UNTIME,
|
|
$ ZERO ) / DBLE( IC )
|
|
OPCNTS( IPAR, ITYPE, IN, 9 ) = OPS / DBLE( IC )
|
|
LDS = LDA
|
|
LDQ = LDA
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 9 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 9 )
|
|
TIMES( IPAR, ITYPE, IN, 9 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 9 )
|
|
END IF
|
|
480 CONTINUE
|
|
END IF
|
|
*
|
|
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
*
|
|
* Time DTGEVC
|
|
*
|
|
IF( TIMSUB( 10 ) .OR. TIMSUB( 11 ) .OR. TIMSUB( 12 ) .OR.
|
|
$ TIMSUB( 13 ) ) THEN
|
|
DO 610 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
DO 490 J = 10, 13
|
|
IF( TIMSUB( J ) ) THEN
|
|
TIMES( IPAR, ITYPE, IN, J ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, J ) = ZERO
|
|
END IF
|
|
490 CONTINUE
|
|
GO TO 610
|
|
END IF
|
|
*
|
|
* If this value of LDA has come up before, just use
|
|
* the value previously computed.
|
|
*
|
|
LASTL = 0
|
|
DO 500 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
500 CONTINUE
|
|
*
|
|
* Time DTGEVC if this is a new value of LDA
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Copy S (which is in A) and P (which is in B)
|
|
* if necessary to get right LDA.
|
|
*
|
|
IF( LDA.GT.LDS ) THEN
|
|
DO 520 JC = N, 1, -1
|
|
DO 510 JR = N, 1, -1
|
|
A( JR+( JC-1 )*LDA ) = A( JR+( JC-1 )*
|
|
$ LDS )
|
|
B( JR+( JC-1 )*LDA ) = B( JR+( JC-1 )*
|
|
$ LDS )
|
|
510 CONTINUE
|
|
520 CONTINUE
|
|
ELSE IF( LDA.LT.LDS ) THEN
|
|
DO 540 JC = 1, N
|
|
DO 530 JR = 1, N
|
|
A( JR+( JC-1 )*LDA ) = A( JR+( JC-1 )*
|
|
$ LDS )
|
|
B( JR+( JC-1 )*LDA ) = B( JR+( JC-1 )*
|
|
$ LDS )
|
|
530 CONTINUE
|
|
540 CONTINUE
|
|
END IF
|
|
LDS = LDA
|
|
*
|
|
* Time DTGEVC for Left Eigenvectors only,
|
|
* without back transforming
|
|
*
|
|
IF( TIMSUB( 10 ) ) THEN
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
550 CONTINUE
|
|
CALL DTGEVC( 'L', 'A', LLWORK, N, A, LDA, B,
|
|
$ LDA, H, LDA, T, LDA, N, ITEMP,
|
|
$ WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 10 )(1:ILA_LEN_TRIM( SUBNAM( 10 ) )),
|
|
$ IINFO, N, ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 550
|
|
*
|
|
TIMES( IPAR, ITYPE, IN, 10 ) = TIME / DBLE( IC )
|
|
OPCNTS( IPAR, ITYPE, IN, 10 ) = OPS / DBLE( IC )
|
|
END IF
|
|
*
|
|
* Time DTGEVC for Left Eigenvectors only,
|
|
* with back transforming
|
|
*
|
|
IF( TIMSUB( 11 ) ) THEN
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
560 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, Q, LDQ, H, LDA )
|
|
CALL DTGEVC( 'L', 'B', LLWORK, N, A, LDA, B,
|
|
$ LDA, H, LDA, T, LDA, N, ITEMP,
|
|
$ WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 11 )(1:ILA_LEN_TRIM( SUBNAM( 11 ) )),
|
|
$ IINFO, N, ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 560
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 570 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, Q, LDQ, H, LDA )
|
|
570 CONTINUE
|
|
S2 = DSECND( )
|
|
UNTIME = S2 - S1
|
|
*
|
|
TIMES( IPAR, ITYPE, IN, 11 ) = MAX( TIME-UNTIME,
|
|
$ ZERO ) / DBLE( IC )
|
|
OPCNTS( IPAR, ITYPE, IN, 11 ) = OPS / DBLE( IC )
|
|
END IF
|
|
*
|
|
* Time DTGEVC for Right Eigenvectors only,
|
|
* without back transforming
|
|
*
|
|
IF( TIMSUB( 12 ) ) THEN
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
580 CONTINUE
|
|
CALL DTGEVC( 'R', 'A', LLWORK, N, A, LDA, B,
|
|
$ LDA, H, LDA, T, LDA, N, ITEMP,
|
|
$ WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 12 )(1:ILA_LEN_TRIM( SUBNAM( 12 ) )),
|
|
$ IINFO, N, ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 580
|
|
*
|
|
TIMES( IPAR, ITYPE, IN, 12 ) = TIME / DBLE( IC )
|
|
OPCNTS( IPAR, ITYPE, IN, 12 ) = OPS / DBLE( IC )
|
|
END IF
|
|
*
|
|
* Time DTGEVC for Right Eigenvectors only,
|
|
* with back transforming
|
|
*
|
|
IF( TIMSUB( 13 ) ) THEN
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
590 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, Q, LDQ, T, LDA )
|
|
CALL DTGEVC( 'R', 'B', LLWORK, N, A, LDA, B,
|
|
$ LDA, H, LDA, T, LDA, N, ITEMP,
|
|
$ WORK, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 13 )(1:ILA_LEN_TRIM( SUBNAM( 13 ) )),
|
|
$ IINFO, N, ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 590
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 600 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, Q, LDQ, T, LDA )
|
|
600 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
|
|
*
|
|
ELSE
|
|
*
|
|
* If this LDA has previously appeared, use the
|
|
* previously computed value(s).
|
|
*
|
|
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
|
|
END IF
|
|
610 CONTINUE
|
|
END IF
|
|
*
|
|
* Time the EISPACK Routines
|
|
*
|
|
* Restore random number seed
|
|
*
|
|
DO 620 J = 1, 4
|
|
ISEED( J ) = IOLDSD( J )
|
|
620 CONTINUE
|
|
*
|
|
* Re-generate A
|
|
*
|
|
IF( ITYPE.LE.MAXTYP ) THEN
|
|
*
|
|
* Generate A (w/o rotation)
|
|
*
|
|
CALL DLATM4( KATYPE( ITYPE ), N, 3, 1, 2, ONE, ULP, ONE,
|
|
$ 2, ISEED, A, N1 )
|
|
IF( 3.LE.N )
|
|
$ A( 3+2*N1 ) = ONE
|
|
*
|
|
* Generate B (w/o rotation)
|
|
*
|
|
CALL DLATM4( 8, N, 3, 1, 0, ONE, ONE, ONE, 2, ISEED, B,
|
|
$ N1 )
|
|
IF( 2.LE.N )
|
|
$ B( 2+N1 ) = ONE
|
|
*
|
|
IF( N.GT.0 ) THEN
|
|
*
|
|
* Include rotations
|
|
*
|
|
* Generate U, V as Householder transformations times
|
|
* a diagonal matrix.
|
|
*
|
|
DO 640 JC = 1, N - 1
|
|
IC = ( JC-1 )*N1
|
|
DO 630 JR = JC, N
|
|
Q( JR+IC ) = DLARND( 3, ISEED )
|
|
Z( JR+IC ) = DLARND( 3, ISEED )
|
|
630 CONTINUE
|
|
CALL DLARFG( N+1-JC, Q( JC+IC ), Q( JC+1+IC ), 1,
|
|
$ WORK( JC ) )
|
|
WORK( 2*N+JC ) = SIGN( ONE, Q( JC+IC ) )
|
|
Q( JC+IC ) = ONE
|
|
CALL DLARFG( N+1-JC, Z( JC+IC ), Z( JC+1+IC ), 1,
|
|
$ WORK( N+JC ) )
|
|
WORK( 3*N+JC ) = SIGN( ONE, Z( JC+IC ) )
|
|
Z( JC+IC ) = ONE
|
|
640 CONTINUE
|
|
IC = ( N-1 )*N1
|
|
Q( N+IC ) = ONE
|
|
WORK( N ) = ZERO
|
|
WORK( 3*N ) = SIGN( ONE, DLARND( 2, ISEED ) )
|
|
Z( N+IC ) = ONE
|
|
WORK( 2*N ) = ZERO
|
|
WORK( 4*N ) = SIGN( ONE, DLARND( 2, ISEED ) )
|
|
*
|
|
* Apply the diagonal matrices
|
|
*
|
|
DO 660 JC = 1, N
|
|
DO 650 JR = 1, N
|
|
A( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
|
|
$ A( JR+IC )
|
|
B( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
|
|
$ B( JR+IC )
|
|
650 CONTINUE
|
|
660 CONTINUE
|
|
CALL DORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, A, N1,
|
|
$ WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 670
|
|
CALL DORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
|
|
$ A, N1, WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 670
|
|
CALL DORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, B, N1,
|
|
$ WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 670
|
|
CALL DORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
|
|
$ B, N1, WORK( 2*N+1 ), IINFO )
|
|
IF( IINFO.NE.0 )
|
|
$ GO TO 670
|
|
END IF
|
|
670 CONTINUE
|
|
END IF
|
|
*
|
|
* Time QZHES w/ MATZ=.FALSE. for each LDAS(j)
|
|
*
|
|
IF( TIMSUB( 14 ) ) THEN
|
|
DO 710 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 14 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 14 ) = ZERO
|
|
GO TO 710
|
|
END IF
|
|
*
|
|
* If this value of LDA has come up before, just use
|
|
* the value previously computed.
|
|
*
|
|
LASTL = 0
|
|
DO 680 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
680 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time QZHES( ...,.FALSE.,..)
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
690 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, LDA )
|
|
CALL QZHES( LDA, N, H, T, .FALSE., Q )
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 690
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 700 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, A, N1, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, Z, LDA )
|
|
700 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 )
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 14 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 14 )
|
|
TIMES( IPAR, ITYPE, IN, 14 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 14 )
|
|
END IF
|
|
LDH = LDA
|
|
710 CONTINUE
|
|
ELSE IF( RUNHES ) THEN
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, N1 )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, N1 )
|
|
CALL QZHES( N1, N, H, T, .FALSE., Q )
|
|
LDH = N1
|
|
END IF
|
|
*
|
|
* Time QZHES w/ MATZ=.TRUE. for each LDAS(j)
|
|
*
|
|
IF( TIMSUB( 15 ) ) THEN
|
|
DO 750 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 15 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 15 ) = ZERO
|
|
GO TO 750
|
|
END IF
|
|
*
|
|
* If this value of LDA has come up before, just use
|
|
* the value previously computed.
|
|
*
|
|
LASTL = 0
|
|
DO 720 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
720 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time QZHES( ...,.TRUE.,..)
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
730 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, A, N1, H, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, T, LDA )
|
|
CALL QZHES( LDA, N, H, T, .TRUE., Q )
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 730
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 740 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, A, N1, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, N1, Z, LDA )
|
|
740 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 )
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 15 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 15 )
|
|
TIMES( IPAR, ITYPE, IN, 15 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 15 )
|
|
END IF
|
|
LDH = LDA
|
|
750 CONTINUE
|
|
END IF
|
|
*
|
|
* Time QZIT and QZVAL w/ MATZ=.FALSE. for each LDAS(j)
|
|
*
|
|
IF( TIMSUB( 16 ) ) THEN
|
|
DO 790 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 16 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 16 ) = ZERO
|
|
GO TO 790
|
|
END IF
|
|
*
|
|
* If this value of LDA has come up before, just use
|
|
* the value previously computed.
|
|
*
|
|
LASTL = 0
|
|
DO 760 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
760 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time QZIT and QZVAL with MATZ=.FALSE.
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
770 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, LDA )
|
|
CALL QZIT( LDA, N, A, B, ZERO, .FALSE., Q, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 16 )(1:ILA_LEN_TRIM( SUBNAM( 16 ) )), IINFO,
|
|
$ N, ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
*
|
|
CALL QZVAL( LDA, N, A, B, W, W( LDA+1 ),
|
|
$ W( 2*LDA+1 ), .FALSE., Q )
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 770
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 780 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, H, LDH, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, Z, LDA )
|
|
780 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 )
|
|
ELSE
|
|
OPCNTS( IPAR, ITYPE, IN, 16 ) = OPCNTS( LASTL,
|
|
$ ITYPE, IN, 16 )
|
|
TIMES( IPAR, ITYPE, IN, 16 ) = TIMES( LASTL, ITYPE,
|
|
$ IN, 16 )
|
|
END IF
|
|
LDS = 0
|
|
790 CONTINUE
|
|
END IF
|
|
*
|
|
* Time QZIT and QZVAL w/ MATZ=.TRUE. for each LDAS(j)
|
|
*
|
|
IF( TIMSUB( 17 ) ) THEN
|
|
DO 830 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 17 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 17 ) = ZERO
|
|
GO TO 830
|
|
END IF
|
|
*
|
|
* If this value of LDA has come up before, just use
|
|
* the value previously computed.
|
|
*
|
|
LASTL = 0
|
|
DO 800 J = 1, IPAR - 1
|
|
IF( LDA.EQ.LDAS( J ) )
|
|
$ LASTL = J
|
|
800 CONTINUE
|
|
*
|
|
IF( LASTL.EQ.0 ) THEN
|
|
*
|
|
* Time QZIT and QZVAL with MATZ=.TRUE.
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
810 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, LDA )
|
|
CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDA )
|
|
CALL QZIT( LDA, N, A, B, ZERO, .TRUE., Q, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 17 )(1:ILA_LEN_TRIM( SUBNAM( 17 ) )), IINFO,
|
|
$ N, ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
*
|
|
CALL QZVAL( LDA, N, A, B, W, W( LDA+1 ),
|
|
$ W( 2*LDA+1 ), .TRUE., Q )
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 810
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 820 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, H, LDH, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, Z, LDA )
|
|
CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDA )
|
|
820 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
|
|
LDS = LDA
|
|
LDW = LDA
|
|
830 CONTINUE
|
|
ELSE IF( RUNQZ ) THEN
|
|
CALL DLACPY( 'Full', N, N, H, LDH, A, N1 )
|
|
CALL DLACPY( 'Full', N, N, T, LDH, B, N1 )
|
|
CALL DLASET( 'Full', N, N, ZERO, ONE, Q, N1 )
|
|
CALL QZIT( N1, N, A, B, ZERO, .TRUE., Q, IINFO )
|
|
IF( IINFO.NE.0 ) THEN
|
|
WRITE( NOUT, FMT = 9997 )
|
|
$ SUBNAM( 17 )(1:ILA_LEN_TRIM( SUBNAM( 17 ) )), IINFO, N,
|
|
$ ITYPE, IPAR, IOLDSD
|
|
INFO = ABS( IINFO )
|
|
GO TO 920
|
|
END IF
|
|
*
|
|
CALL QZVAL( N1, N, A, B, W, W( N1+1 ), W( 2*N1+1 ),
|
|
$ .TRUE., Q )
|
|
LDS = N1
|
|
LDW = N1
|
|
END IF
|
|
*
|
|
* Time QZVEC for each LDAS(j)
|
|
*
|
|
IF( TIMSUB( 18 ) ) THEN
|
|
DO 910 IPAR = 1, NPARMS
|
|
LDA = LDAS( IPAR )
|
|
IF( LDA.LT.N1 ) THEN
|
|
TIMES( IPAR, ITYPE, IN, 18 ) = ZERO
|
|
OPCNTS( IPAR, ITYPE, IN, 18 ) = ZERO
|
|
GO TO 910
|
|
END IF
|
|
*
|
|
* 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
|
|
*
|
|
* Copy W if necessary to get right LDA.
|
|
*
|
|
IF( LDA.GT.LDW ) THEN
|
|
DO 860 JC = 3, 1, -1
|
|
DO 850 JR = N, 1, -1
|
|
W( JR+( JC-1 )*LDA ) = W( JR+( JC-1 )*
|
|
$ LDW )
|
|
850 CONTINUE
|
|
860 CONTINUE
|
|
ELSE IF( LDA.LT.LDW ) THEN
|
|
DO 880 JC = 1, 3
|
|
DO 870 JR = 1, N
|
|
W( JR+( JC-1 )*LDA ) = W( JR+( JC-1 )*
|
|
$ LDW )
|
|
870 CONTINUE
|
|
880 CONTINUE
|
|
END IF
|
|
LDW = LDA
|
|
*
|
|
* Time QZVEC
|
|
*
|
|
IC = 0
|
|
OPS = ZERO
|
|
S1 = DSECND( )
|
|
890 CONTINUE
|
|
CALL DLACPY( 'Full', N, N, A, LDS, H, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, LDS, T, LDA )
|
|
CALL DLACPY( 'Full', N, N, Q, LDS, Z, LDA )
|
|
CALL QZVEC( LDA, N, H, T, W, W( LDA+1 ),
|
|
$ W( 2*LDA+1 ), Z )
|
|
S2 = DSECND( )
|
|
TIME = S2 - S1
|
|
IC = IC + 1
|
|
IF( TIME.LT.TIMMIN )
|
|
$ GO TO 890
|
|
*
|
|
* Subtract the time used in DLACPY.
|
|
*
|
|
S1 = DSECND( )
|
|
DO 900 J = 1, IC
|
|
CALL DLACPY( 'Full', N, N, A, LDS, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, B, LDS, Z, LDA )
|
|
CALL DLACPY( 'Full', N, N, Q, LDS, Z, LDA )
|
|
900 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
|
|
910 CONTINUE
|
|
END IF
|
|
*
|
|
920 CONTINUE
|
|
930 CONTINUE
|
|
*
|
|
* Print a table of results for each timed routine.
|
|
*
|
|
DO 940 ISUB = 1, NSUBS
|
|
IF( TIMSUB( ISUB ) ) THEN
|
|
CALL DPRTBG( SUBNAM( ISUB ), MTYPES, DOTYPE, NSIZES, NN,
|
|
$ INPARM( ISUB ), PNAMES, NPARMS, LDAS, NNB,
|
|
$ NSHFTS, NEISPS, MINNBS, MINBKS,
|
|
$ OPCNTS( 1, 1, 1, ISUB ), LDO1, LDO2,
|
|
$ TIMES( 1, 1, 1, ISUB ), LDT1, LDT2, WORK,
|
|
$ LLWORK, NOUT )
|
|
END IF
|
|
940 CONTINUE
|
|
*
|
|
RETURN
|
|
*
|
|
* End of DTIM51
|
|
*
|
|
9997 FORMAT( ' DTIM51: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
|
|
$ I6, ', ITYPE=', I6, ', IPAR=', I6, ', ISEED=(',
|
|
$ 3( I5, ',' ), I5, ')' )
|
|
*
|
|
END
|