Patch was based on 3.3.0, so required a little bit of merging.
Thank you Sven for the corrections.
Julie
JL
TESTING/EIG
zerrgg.f
Declare ILO, IHI
SRC
---
I have corrected all the following warnings and errors:
c/d/s/zsysv.f, Unused external reference ILAENV
>JL OK
c/d/s/zsysv.f, Unused local variable NB
>JL ALREADY CORRECTED
sgsvj0.f, Unused intrinsic AMIN1
> JL OK
d/sorbdb.f, Unused intrinsic MIN
> JL OK
sorcsd.f, Unused intrinsic SIN
sorcsd.f, Unused intrinsic COS
> JL OK MERGE
cpoequb.f, Unused intrinsic AIMAG
cpoequb.f, Unused intrinsic REAL
cpoequb.f, Unused local variable ZDUM
zgeequb.f, REAL --> DBLE
> JL OK
sorcsd.f, line 330: Inconsistent data type REAL (previously INTEGER) for argument 14 in reference to SORBDB
sorcsd.f, line 340: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR
sorcsd.f, line 345: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR
sorcsd.f, line 356: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ
sorcsd.f, line 363: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ
sorcsd.f, line 369: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ
sorcsd.f, line 374: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGLQ
sorcsd.f, line 385: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR
sorcsd.f, line 392: Inconsistent data type REAL (previously INTEGER) for argument 4 in reference to SORGQR
sorcsd.f, line 399: Inconsistent data type REAL (previously INTEGER) for argument 9 in reference to SBBCSD
> JL OK MERGE
ila(s/d/c/z)lr.f
In the WHILE loop, at about line 59 I inserted
IF (I.EQ.0) THEN
EXIT
END IF
since, otherwise when I = 0, A(0,J) is referenced.
> JL OK
TESTING/MATGEN
--------------
s/dlatm7.f
line 187: I replaced
IF( N.GT.1 ) THEN
by
IF( N.GT.1 .AND. RANK.GT.1 ) THEN
Otherwise I get a division by zero.
> JL OK
s/dlaror.f
I moved:
INFO = 0
from line 125 to line 121 in front of
IF( N.EQ.0 .OR. M.EQ.0 )
$ RETURN
otherwise INFO is not defined on return when N or M are zero.
Similar change for
c/zlaror.f
> JL OK
TESTING/LIN
-----------
s/derrsy.f
In calls to S/DSYTRI2: I replaced IW by IW(1) since the dummy argument
(LWORK) is a scalar.
> JL OK
c/zerrrfp.f
I made ALPHA and BETA REAL/DOUBLE and introduced COMPLEX/COMPLEX*16
CALPHA since calls to C/ZHFRK need real alpha and beta. In calls to
CTFSM, I then replaced ALPHA with CALPHA.
In cerrrfp.f, I replaced 1.0D0 with 1.0E0 (not strictly necessary, but
cleaner).
> JL OK
dpot06.f
Removed the unused declaration of LSAME
> JL OK
d/zdrvac.f
Removed the unused declaration of LSAME
> JL OK MERGE
s/d/c/z/ckcsd.f
Removed the unused declarations of S/D/C/ZLANGE, SIN and COS
> JL OK
c/zgennd.f
Removed the unused variable OUT
> JL already DONE
Corrected the following warnings and errors:
dchksy.f, Unused local variable MYWORK
> JL already DONE
ddrvgbx.f, line 792: Different number of arguments from the first call of DGBT02
> JL OK
cdrvgbx.f, line 726: Inconsistent data type REAL (previously COMPLEX) for argument 4 in reference to CLASET
cdrvgbx.f, line 728: Inconsistent data type REAL (previously COMPLEX) for argument 4 in reference to CLASET
cdrvgbx.f, line 780: Inconsistent data type REAL (previously COMPLEX) for argument 10 in reference to CGBT01
cdrvgbx.f, line 794: Different number of arguments from the first call of CGBT02
> JL OK
zdrvgbx.f, line 726: Inconsistent data type DOUBLE PRECISION (previously COMPLEX(KIND(0d0))) for argument 4 in reference to ZLASET
zdrvgbx.f, line 728: Inconsistent data type DOUBLE PRECISION (previously COMPLEX(KIND(0d0))) for argument 4 in reference to ZLASET
zdrvgbx.f, line 780: Inconsistent data type DOUBLE PRECISION (previously COMPLEX(KIND(0d0))) for argument 10 in reference to ZGBT01
zdrvgbx.f, line 794: Different number of arguments from the first call of ZGBT02
> JL OK
TESTING/EIG
-----------
s/d/c/zchkee.f
I inserted
CALL XLAENV( 12, 1 )
at line 1208, since IPARMS(ISPEC) with ISPEC = 12 needs to be set.
(I think I had to do this with them all, certainly with zchkee.f)
> JL OK zchkee.f cchkee.f
c/zchkee.f
In line 2316, the 15th argument of C/ZCKCSD should be real, not complex,
so I replaced A(1,7) by RWORK.
> JL OK
c/zcsdts.f
In calls to C/ZHERK I have replaced ONE by REALONE as arguments 5 and 8
should be real.
> JL OK
s/d/c/zcsdts.f
Division by zero occurs at line 155 in computing EPS when M = 0, so I
have modified
EPS2 = MAX( ULP, CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) )
to
IF (M.GT.0) THEN
EPS2 = MAX( ULP,
$ CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) )
ELSE
EPS2 = ULP
END IF
> JL OK
SRC/VARIANTS/lu/CR
------------------
s/d/c/zgetrf
Removed the unused intrinsic MOD
> JL OK
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
*
+* =====================================================================
* .. Local Scalars ..
INTEGER I1, I2
* ..
EXTERNAL ILAENV
* ..
* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, MOD
+ INTRINSIC MAX, MIN
* ..
* .. Executable Statements ..
*
EXTERNAL ILAENV
* ..
* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, MOD
+ INTRINSIC MAX, MIN
* ..
* .. Executable Statements ..
*
EXTERNAL ILAENV
* ..
* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, MOD
+ INTRINSIC MAX, MIN
* ..
* .. Executable Statements ..
*
EXTERNAL ILAENV
* ..
* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, MOD
+ INTRINSIC MAX, MIN
* ..
* .. Executable Statements ..
*
EXTERNAL XERBLA
* ..
* .. Intrinsic Functions ..
- INTRINSIC MAX, MIN, SQRT, LOG, INT, REAL, AIMAG
+ INTRINSIC MAX, MIN, SQRT, LOG, INT
* ..
* .. Executable Statements ..
*
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, CSYTRF, CSYTRS, CSYTRS2
EXTERNAL DNRM2, LSAME
* ..
* .. Intrinsic Functions
- INTRINSIC ATAN2, COS, MAX, MIN, SIN
+ INTRINSIC ATAN2, COS, MAX, SIN
* ..
* .. Executable Statements ..
*
EXTERNAL LSAME
* ..
* .. Intrinsic Functions
- INTRINSIC COS, INT, MAX, MIN, SIN
+ INTRINSIC INT, MAX, MIN
* ..
* .. Executable Statements ..
*
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, DSYTRF, DSYTRS, DSYTRS2
ILACLR = 0
DO J = 1, N
I=M
- DO WHILE ((A(I,J).EQ.ZERO).AND.(I.GT.1))
- I=I-1
- ENDDO
- IF( (I.EQ.1).AND.(A(1,J).EQ.ZERO) ) THEN
- I = 0
- END IF
+ DO WHILE ((A(I,J).NE.ZERO).AND.(I.GE.1))
+ I=I-1
+ IF (I.EQ.0) THEN
+ EXIT
+ END IF
+ ENDDO
ILACLR = MAX( ILACLR, I )
END DO
END IF
* Scan up each column tracking the last zero row seen.
ILADLR = 0
DO J = 1, N
- I = M
- DO WHILE ((A(I,J).EQ.ZERO).AND.(I.GT.1))
- I=I-1
+ I=M
+ DO WHILE ((A(I,J).NE.ZERO).AND.(I.GE.1))
+ I=I-1
+ IF (I.EQ.0) THEN
+ EXIT
+ END IF
ENDDO
- IF( (I.EQ.1).AND.(A(1,J).EQ.ZERO) ) THEN
- I = 0
- END IF
ILADLR = MAX( ILADLR, I )
END DO
END IF
ILASLR = 0
DO J = 1, N
I=M
- DO WHILE ((A(I,J).EQ.ZERO).AND.(I.GT.1))
- I=I-1
+ DO WHILE ((A(I,J).NE.ZERO).AND.(I.GE.1))
+ I=I-1
+ IF (I.EQ.0) THEN
+ EXIT
+ END IF
ENDDO
- IF( (I.EQ.1).AND.(A(1,J).EQ.ZERO) ) THEN
- I = 0
- END IF
ILASLR = MAX( ILASLR, I )
END DO
END IF
ILAZLR = 0
DO J = 1, N
I=M
- DO WHILE ((A(I,J).EQ.ZERO).AND.(I.GT.1))
- I=I-1
- ENDDO
- IF( (I.EQ.1).AND.(A(1,J).EQ.ZERO) ) THEN
- I = 0
- END IF
+ DO WHILE ((A(I,J).NE.ZERO).AND.(I.GE.1))
+ I=I-1
+ IF (I.EQ.0) THEN
+ EXIT
+ END IF
+ ENDDO
ILAZLR = MAX( ILAZLR, I )
END DO
END IF
REAL FASTR( 5 )
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, AMAX1, AMIN1, FLOAT, MIN0, SIGN, SQRT
+ INTRINSIC ABS, AMAX1, FLOAT, MIN0, SIGN, SQRT
* ..
* .. External Functions ..
REAL SDOT, SNRM2
EXTERNAL SNRM2, LSAME
* ..
* .. Intrinsic Functions
- INTRINSIC ATAN2, COS, MAX, MIN, SIN
+ INTRINSIC ATAN2, COS, MAX, SIN
* ..
* .. Executable Statements ..
*
$ PIOVER2 = 1.57079632679489662E0,
$ ZERO = 0.0E+0 )
* ..
+* .. Local Arrays ..
+ REAL DUMMY(1)
+* ..
* .. Local Scalars ..
CHARACTER TRANST, SIGNST
INTEGER CHILDINFO, I, IB11D, IB11E, IB12D, IB12E,
EXTERNAL LSAME
* ..
* .. Intrinsic Functions
- INTRINSIC COS, INT, MAX, MIN, SIN
+ INTRINSIC INT, MAX, MIN
* ..
* .. Executable Statements ..
*
ITAUQ1 = ITAUP2 + MAX( 1, M - P )
ITAUQ2 = ITAUQ1 + MAX( 1, Q )
IORGQR = ITAUQ2 + MAX( 1, M - Q )
- CALL SORGQR( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), 0, WORK, -1,
+ CALL SORGQR( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1,
$ CHILDINFO )
LORGQRWORKOPT = INT( WORK(1) )
LORGQRWORKMIN = MAX( 1, M - Q )
IORGLQ = ITAUQ2 + MAX( 1, M - Q )
- CALL SORGLQ( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), 0, WORK, -1,
+ CALL SORGLQ( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1,
$ CHILDINFO )
LORGLQWORKOPT = INT( WORK(1) )
LORGLQWORKMIN = MAX( 1, M - Q )
IORBDB = ITAUQ2 + MAX( 1, M - Q )
CALL SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
- $ X21, LDX21, X22, LDX22, 0, 0, 0, 0, 0, 0, WORK,
- $ -1, CHILDINFO )
+ $ X21, LDX21, X22, LDX22, DUMMY, DUMMY, DUMMY, DUMMY, DUMMY,
+ $ DUMMY,WORK,-1,CHILDINFO )
LORBDBWORKOPT = INT( WORK(1) )
LORBDBWORKMIN = LORBDBWORKOPT
IB11D = ITAUQ2 + MAX( 1, M - Q )
IB22D = IB21E + MAX( 1, Q - 1 )
IB22E = IB22D + MAX( 1, Q )
IBBCSD = IB22E + MAX( 1, Q - 1 )
- CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, 0,
- $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, LDV2T, 0,
- $ 0, 0, 0, 0, 0, 0, 0, WORK, -1, CHILDINFO )
+ CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q,
+ $ DUMMY, DUMMY, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
+ $ LDV2T, DUMMY, DUMMY, DUMMY, DUMMY, DUMMY, DUMMY,
+ $ DUMMY, DUMMY, WORK, -1, CHILDINFO )
LBBCSDWORKOPT = INT( WORK(1) )
LBBCSDWORKMIN = LBBCSDWORKOPT
LWORKOPT = MAX( IORGQR + LORGQRWORKOPT, IORGLQ + LORGLQWORKOPT,
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, SSYTRF, SSYTRS, SSYTRS2
IF( N.EQ.0 ) THEN
LWKOPT = 1
ELSE
- CALL SSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
+ CALL SSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT = WORK(1)
END IF
WORK( 1 ) = LWKOPT
EXTERNAL XERBLA
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, MAX, MIN, LOG, REAL, DIMAG
+ INTRINSIC ABS, MAX, MIN, LOG, DBLE, DIMAG
* ..
* .. Statement Functions ..
DOUBLE PRECISION CABS1
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZSYTRF, ZSYTRS, ZSYTRS2
*
READ( NIN, FMT = * )THRESH
CALL XLAENV( 1, 1 )
+ CALL XLAENV( 12, 1 )
TSTERR = .TRUE.
CALL CCHKEC( THRESH, TSTERR, NIN, NOUT )
GO TO 380
$ CALL CERRGG( 'CSD', NOUT )
CALL CCKCSD( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX,
$ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), A( 1, 4 ),
- $ A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), IWORK, WORK,
+ $ A( 1, 5 ), A( 1, 6 ), RWORK, IWORK, WORK,
$ DR( 1, 1 ), NIN, NOUT, INFO )
IF( INFO.NE.0 )
$ WRITE( NOUT, FMT = 9980 )'CCKCSD', INFO
$ CLASET
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, MIN, SIN
+ INTRINSIC ABS, MIN
* ..
* .. External Functions ..
- REAL CLANGE, SLARND
- EXTERNAL CLANGE, SLARND
+ REAL SLARND
+ EXTERNAL SLARND
* ..
* .. Executable Statements ..
*
ULP = SLAMCH( 'Precision' )
ULPINV = REALONE / ULP
CALL CLASET( 'Full', M, M, ZERO, ONE, WORK, LDX )
- CALL CHERK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX,
- $ ONE, WORK, LDX )
- EPS2 = MAX( ULP,
- $ CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) )
+ CALL CHERK( 'Upper', 'Conjugate transpose', M, M, -REALONE,
+ $ X, LDX, REALONE, WORK, LDX )
+ IF (M.GT.0) THEN
+ EPS2 = MAX( ULP,
+ $ CLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) )
+ ELSE
+ EPS2 = ULP
+ END IF
R = MIN( P, M-P, Q, M-Q )
*
* Copy the matrix X to the array XF.
* Compute I - U1'*U1
*
CALL CLASET( 'Full', P, P, ZERO, ONE, WORK, LDU1 )
- CALL CHERK( 'Upper', 'Conjugate transpose', P, P, -ONE, U1, LDU1,
- $ ONE, WORK, LDU1 )
+ CALL CHERK( 'Upper', 'Conjugate transpose', P, P, -REALONE,
+ $ U1, LDU1, REALONE, WORK, LDU1 )
*
* Compute norm( I - U'*U ) / ( MAX(1,P) * ULP ) .
*
* Compute I - U2'*U2
*
CALL CLASET( 'Full', M-P, M-P, ZERO, ONE, WORK, LDU2 )
- CALL CHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -ONE, U2,
- $ LDU2, ONE, WORK, LDU2 )
+ CALL CHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -REALONE,
+ $ U2, LDU2, REALONE, WORK, LDU2 )
*
* Compute norm( I - U2'*U2 ) / ( MAX(1,M-P) * ULP ) .
*
* Compute I - V1T*V1T'
*
CALL CLASET( 'Full', Q, Q, ZERO, ONE, WORK, LDV1T )
- CALL CHERK( 'Upper', 'No transpose', Q, Q, -ONE, V1T, LDV1T, ONE,
- $ WORK, LDV1T )
+ CALL CHERK( 'Upper', 'No transpose', Q, Q, -REALONE,
+ $ V1T, LDV1T, REALONE, WORK, LDV1T )
*
* Compute norm( I - V1T*V1T' ) / ( MAX(1,Q) * ULP ) .
*
* Compute I - V2T*V2T'
*
CALL CLASET( 'Full', M-Q, M-Q, ZERO, ONE, WORK, LDV2T )
- CALL CHERK( 'Upper', 'No transpose', M-Q, M-Q, -ONE, V2T, LDV2T,
- $ ONE, WORK, LDV2T )
+ CALL CHERK( 'Upper', 'No transpose', M-Q, M-Q, -REALONE,
+ $ V2T, LDV2T, REALONE, WORK, LDV2T )
*
* Compute norm( I - V2T*V2T' ) / ( MAX(1,M-Q) * ULP ) .
*
* ..
* .. Local Scalars ..
CHARACTER*2 C2
- INTEGER DUMMYK, DUMMYL, I, IFST, ILST, INFO, J, M,
- $ NCYCLE, NT, SDIM
+ INTEGER DUMMYK, DUMMYL, I, IFST, IHI, ILO, ILST, INFO,
+ $ J, M, NCYCLE, NT, SDIM
REAL ANRM, BNRM, DIF, SCALE, TOLA, TOLB
* ..
* .. Local Arrays ..
$ DLASET
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, MIN, SIN
+ INTRINSIC ABS, MIN
* ..
* .. External Functions ..
- DOUBLE PRECISION DLANGE, DLARND
- EXTERNAL DLANGE, DLARND
+ DOUBLE PRECISION DLARND
+ EXTERNAL DLARND
* ..
* .. Executable Statements ..
*
CALL DLASET( 'Full', M, M, ZERO, ONE, WORK, LDX )
CALL DSYRK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX,
$ ONE, WORK, LDX )
- EPS2 = MAX( ULP,
- $ DLANGE( '1', M, M, WORK, LDX, RWORK ) / DBLE( M ) )
+ IF (M.GT.0) THEN
+ EPS2 = MAX( ULP,
+ $ DLANGE( '1', M, M, WORK, LDX, RWORK ) / DBLE( M ) )
+ ELSE
+ EPS2 = ULP
+ END IF
R = MIN( P, M-P, Q, M-Q )
*
* Copy the matrix X to the array XF.
$ SLASET
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, MIN, SIN
+ INTRINSIC ABS, MIN
* ..
* .. External Functions ..
- REAL SLANGE, SLARND
- EXTERNAL SLANGE, SLARND
+ REAL SLARND
+ EXTERNAL SLARND
* ..
* .. Executable Statements ..
*
CALL SLASET( 'Full', M, M, ZERO, ONE, WORK, LDX )
CALL SSYRK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX,
$ ONE, WORK, LDX )
- EPS2 = MAX( ULP,
- $ SLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) )
+ IF (M.GT.0) THEN
+ EPS2 = MAX( ULP,
+ $ SLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) )
+ ELSE
+ EPS2 = ULP
+ END IF
R = MIN( P, M-P, Q, M-Q )
*
* Copy the matrix X to the array XF.
*
READ( NIN, FMT = * )THRESH
CALL XLAENV( 1, 1 )
+ CALL XLAENV( 12, 1 )
TSTERR = .TRUE.
CALL ZCHKEC( THRESH, TSTERR, NIN, NOUT )
GO TO 380
$ CALL ZERRGG( 'CSD', NOUT )
CALL ZCKCSD( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX,
$ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), A( 1, 4 ),
- $ A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), IWORK, WORK,
+ $ A( 1, 5 ), A( 1, 6 ), RWORK, IWORK, WORK,
$ DR( 1, 1 ), NIN, NOUT, INFO )
IF( INFO.NE.0 )
$ WRITE( NOUT, FMT = 9980 )'ZCKCSD', INFO
$ ZLASET
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, COS, MIN, SIN
+ INTRINSIC ABS, MIN
* ..
* .. External Functions ..
- DOUBLE PRECISION ZLANGE, DLARND
- EXTERNAL ZLANGE, DLARND
+ DOUBLE PRECISION DLARND
+ EXTERNAL DLARND
* ..
* .. Executable Statements ..
*
ULP = DLAMCH( 'Precision' )
ULPINV = REALONE / ULP
CALL ZLASET( 'Full', M, M, ZERO, ONE, WORK, LDX )
- CALL ZHERK( 'Upper', 'Conjugate transpose', M, M, -ONE, X, LDX,
- $ ONE, WORK, LDX )
- EPS2 = MAX( ULP,
- $ ZLANGE( '1', M, M, WORK, LDX, RWORK ) / REAL( M ) )
+ CALL ZHERK( 'Upper', 'Conjugate transpose', M, M, -REALONE,
+ $ X, LDX, REALONE, WORK, LDX )
+ IF (M.GT.0) THEN
+ EPS2 = MAX( ULP,
+ $ ZLANGE( '1', M, M, WORK, LDX, RWORK ) / DBLE( M ) )
+ ELSE
+ EPS2 = ULP
+ END IF
R = MIN( P, M-P, Q, M-Q )
*
* Copy the matrix X to the array XF.
* Compute I - U1'*U1
*
CALL ZLASET( 'Full', P, P, ZERO, ONE, WORK, LDU1 )
- CALL ZHERK( 'Upper', 'Conjugate transpose', P, P, -ONE, U1, LDU1,
- $ ONE, WORK, LDU1 )
+ CALL ZHERK( 'Upper', 'Conjugate transpose', P, P, -REALONE,
+ $ U1, LDU1, REALONE, WORK, LDU1 )
*
* Compute norm( I - U'*U ) / ( MAX(1,P) * ULP ) .
*
* Compute I - U2'*U2
*
CALL ZLASET( 'Full', M-P, M-P, ZERO, ONE, WORK, LDU2 )
- CALL ZHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -ONE, U2,
- $ LDU2, ONE, WORK, LDU2 )
+ CALL ZHERK( 'Upper', 'Conjugate transpose', M-P, M-P, -REALONE,
+ $ U2, LDU2, REALONE, WORK, LDU2 )
*
* Compute norm( I - U2'*U2 ) / ( MAX(1,M-P) * ULP ) .
*
* Compute I - V1T*V1T'
*
CALL ZLASET( 'Full', Q, Q, ZERO, ONE, WORK, LDV1T )
- CALL ZHERK( 'Upper', 'No transpose', Q, Q, -ONE, V1T, LDV1T, ONE,
- $ WORK, LDV1T )
+ CALL ZHERK( 'Upper', 'No transpose', Q, Q, -REALONE,
+ $ V1T, LDV1T, REALONE, WORK, LDV1T )
*
* Compute norm( I - V1T*V1T' ) / ( MAX(1,Q) * ULP ) .
*
* Compute I - V2T*V2T'
*
CALL ZLASET( 'Full', M-Q, M-Q, ZERO, ONE, WORK, LDV2T )
- CALL ZHERK( 'Upper', 'No transpose', M-Q, M-Q, -ONE, V2T, LDV2T,
- $ ONE, WORK, LDV2T )
+ CALL ZHERK( 'Upper', 'No transpose', M-Q, M-Q, -REALONE,
+ $ V2T, LDV2T, REALONE, WORK, LDV2T )
*
* Compute norm( I - V2T*V2T' ) / ( MAX(1,M-Q) * ULP ) .
*
CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB )
IF( .NOT.PREFAC )
- $ CALL CLASET( 'Full', 2*KL+KU+1, N, ZERO, ZERO,
- $ AFB, LDAFB )
- CALL CLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDB )
+ $ CALL CLASET( 'Full', 2*KL+KU+1, N,
+ $ CMPLX( ZERO ), CMPLX( ZERO ),
+ $ AFB, LDAFB )
+ CALL CLASET( 'Full', N, NRHS,
+ $ CMPLX( ZERO ), CMPLX( ZERO ),
+ $ X, LDB )
IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
*
* Equilibrate the matrix if FACT = 'F' and
* residual.
*
CALL CGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB,
- $ IWORK, RWORK( 2*NRHS+1 ), RESULT( 1 ) )
+ $ IWORK, WORK( 2*NRHS+1 ), RESULT( 1 ) )
K1 = 1
ELSE
K1 = 2
CALL CLACPY( 'Full', N, NRHS, BSAV, LDB, WORK,
$ LDB )
CALL CGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
- $ LDA, X, LDB, WORK, LDB, RWORK( 2*NRHS+1 ),
- $ RESULT( 2 ) )
+ $ LDA, X, LDB, WORK, LDB, RESULT( 2 ) )
*
* Check solution from generated exact solution.
*
$ LDB )
CALL DGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
$ LDA, X, LDB, WORK, LDB,
- $ WORK, RESULT( 2 ) )
+ $ RESULT( 2 ) )
*
* Check solution from generated exact solution.
*
*
SRNAMT = 'DSYTRI2'
INFOT = 1
- CALL DSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
+ CALL DSYTRI2( '/', 0, A, 1, IP, W, IW(1), INFO )
CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
INFOT = 2
- CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
+ CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW(1), INFO )
CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
INFOT = 4
- CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
+ CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO )
CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
*
* DSYTRS
DOUBLE PRECISION ANORM, BNORM, EPS, XNORM
* ..
* .. External Functions ..
- LOGICAL LSAME
INTEGER IDAMAX
DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, IDAMAX, DLAMCH, DLANSY
+ EXTERNAL IDAMAX, DLAMCH, DLANSY
* ..
* .. External Subroutines ..
EXTERNAL DSYMM
*
SRNAMT = 'SSYTRI2'
INFOT = 1
- CALL SSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
+ CALL SSYTRI2( '/', 0, A, 1, IP, W, IW(1), INFO )
CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
INFOT = 2
- CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
+ CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW(1), INFO )
CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
INFOT = 4
- CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
+ CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO )
CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
*
* SSYTRS
* .. Local Variables ..
INTEGER ITER, KASE
* ..
-* .. External Functions ..
- LOGICAL LSAME
- EXTERNAL LSAME
-* ..
* .. External Subroutines ..
EXTERNAL ALAERH, ZLACPY, ZLAIPD,
$ ZLARHS, ZLATB4, ZLATMS,
CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB, B, LDB )
IF( .NOT.PREFAC )
- $ CALL ZLASET( 'Full', 2*KL+KU+1, N, ZERO, ZERO,
- $ AFB, LDAFB )
- CALL ZLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDB )
+ $ CALL ZLASET( 'Full', 2*KL+KU+1, N,
+ $ DCMPLX( ZERO ), DCMPLX( ZERO ),
+ $ AFB, LDAFB )
+ CALL ZLASET( 'Full', N, NRHS,
+ $ DCMPLX( ZERO ), DCMPLX( ZERO ),
+ $ X, LDB )
IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
*
* Equilibrate the matrix if FACT = 'F' and
* residual.
*
CALL ZGBT01( N, N, KL, KU, A, LDA, AFB, LDAFB,
- $ IWORK, RWORK( 2*NRHS+1 ), RESULT( 1 ) )
+ $ IWORK, WORK( 2*NRHS+1 ), RESULT( 1 ) )
K1 = 1
ELSE
K1 = 2
CALL ZLACPY( 'Full', N, NRHS, BSAV, LDB, WORK,
$ LDB )
CALL ZGBT02( TRANS, N, N, KL, KU, NRHS, ASAV,
- $ LDA, X, LDB, WORK, LDB, RWORK( 2*NRHS+1 ),
- $ RESULT( 2 ) )
+ $ LDA, X, LDB, WORK, LDB, RESULT( 2 ) )
*
* Check solution from generated exact solution.
*
* ..
* .. Local Scalars ..
INTEGER INFO
- COMPLEX*16 ALPHA, BETA
+ DOUBLE PRECISION ALPHA, BETA
+ COMPLEX*16 CALPHA
* ..
* .. Local Arrays ..
COMPLEX*16 A( 1, 1), B( 1, 1)
*
NOUT = NUNIT
OK = .TRUE.
- A( 1, 1 ) = DCMPLX( 1.D0 , 1.D0 )
- B( 1, 1 ) = DCMPLX( 1.D0 , 1.D0 )
- ALPHA = DCMPLX( 1.D0 , 1.D0 )
- BETA = DCMPLX( 1.D0 , 1.D0 )
+ A( 1, 1 ) = DCMPLX( 1.0D0 , 1.0D0 )
+ B( 1, 1 ) = DCMPLX( 1.0D0 , 1.0D0 )
+ ALPHA = 1.0D0
+ CALPHA = DCMPLX( 1.0D0 , 1.0D0 )
+ BETA = 1.0D0
*
SRNAMT = 'ZPFTRF'
INFOT = 1
*
SRNAMT = 'ZTFSM '
INFOT = 1
- CALL ZTFSM( '/', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 )
+ CALL ZTFSM( '/', 'L', 'U', 'C', 'U', 0, 0, CALPHA, A, B, 1 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
INFOT = 2
- CALL ZTFSM( 'N', '/', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 1 )
+ CALL ZTFSM( 'N', '/', 'U', 'C', 'U', 0, 0, CALPHA, A, B, 1 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
INFOT = 3
- CALL ZTFSM( 'N', 'L', '/', 'C', 'U', 0, 0, ALPHA, A, B, 1 )
+ CALL ZTFSM( 'N', 'L', '/', 'C', 'U', 0, 0, CALPHA, A, B, 1 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
INFOT = 4
- CALL ZTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, ALPHA, A, B, 1 )
+ CALL ZTFSM( 'N', 'L', 'U', '/', 'U', 0, 0, CALPHA, A, B, 1 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
INFOT = 5
- CALL ZTFSM( 'N', 'L', 'U', 'C', '/', 0, 0, ALPHA, A, B, 1 )
+ CALL ZTFSM( 'N', 'L', 'U', 'C', '/', 0, 0, CALPHA, A, B, 1 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
INFOT = 6
- CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', -1, 0, ALPHA, A, B, 1 )
+ CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', -1, 0, CALPHA, A, B, 1 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
INFOT = 7
- CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, -1, ALPHA, A, B, 1 )
+ CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, -1, CALPHA, A, B, 1 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
INFOT = 11
- CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, 0, ALPHA, A, B, 0 )
+ CALL ZTFSM( 'N', 'L', 'U', 'C', 'U', 0, 0, CALPHA, A, B, 0 )
CALL CHKXER( 'ZTFSM ', INFOT, NOUT, LERR, OK )
*
SRNAMT = 'ZTFTRI'
* ..
* .. Executable Statements ..
*
+ INFO = 0
IF( N.EQ.0 .OR. M.EQ.0 )
$ RETURN
*
*
* Check for argument errors.
*
- INFO = 0
IF( ITYPE.EQ.0 ) THEN
INFO = -1
ELSE IF( M.LT.0 ) THEN
* ..
* .. Executable Statements ..
*
+ INFO = 0
IF( N.EQ.0 .OR. M.EQ.0 )
$ RETURN
*
*
* Check for argument errors.
*
- INFO = 0
IF( ITYPE.EQ.0 ) THEN
INFO = -1
ELSE IF( M.LT.0 ) THEN
*
160 CONTINUE
D( 1 ) = ONE
- IF( N.GT.1 ) THEN
+ IF( N.GT.1 .AND. RANK.GT.1 ) THEN
ALPHA = COND**( -ONE / DBLE( RANK-1 ) )
DO 170 I = 2, RANK
D( I ) = ALPHA**( I-1 )
* ..
* .. Executable Statements ..
*
+ INFO = 0
IF( N.EQ.0 .OR. M.EQ.0 )
$ RETURN
*
*
* Check for argument errors.
*
- INFO = 0
IF( ITYPE.EQ.0 ) THEN
INFO = -1
ELSE IF( M.LT.0 ) THEN
* ..
* .. Executable Statements ..
*
+ INFO = 0
IF( N.EQ.0 .OR. M.EQ.0 )
$ RETURN
*
*
* Check for argument errors.
*
- INFO = 0
IF( ITYPE.EQ.0 ) THEN
INFO = -1
ELSE IF( M.LT.0 ) THEN