Commit patch sent by Sven.
authorjulie <julielangou@users.noreply.github.com>
Fri, 23 Sep 2011 15:26:46 +0000 (15:26 +0000)
committerjulie <julielangou@users.noreply.github.com>
Fri, 23 Sep 2011 15:26:46 +0000 (15:26 +0000)
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

44 files changed:
INSTALL/lsametst.f
SRC/VARIANTS/lu/CR/cgetrf.f
SRC/VARIANTS/lu/CR/dgetrf.f
SRC/VARIANTS/lu/CR/sgetrf.f
SRC/VARIANTS/lu/CR/zgetrf.f
SRC/cpoequb.f
SRC/csysv.f
SRC/dorbdb.f
SRC/dorcsd.f
SRC/dsysv.f
SRC/ilaclr.f
SRC/iladlr.f
SRC/ilaslr.f
SRC/ilazlr.f
SRC/sgsvj0.f
SRC/sorbdb.f
SRC/sorcsd.f
SRC/ssysv.f
SRC/zgeequb.f
SRC/zsysv.f
TESTING/EIG/cchkee.f
TESTING/EIG/cckcsd.f
TESTING/EIG/ccsdts.f
TESTING/EIG/cerrgg.f
TESTING/EIG/dckcsd.f
TESTING/EIG/dcsdts.f
TESTING/EIG/sckcsd.f
TESTING/EIG/scsdts.f
TESTING/EIG/zchkee.f
TESTING/EIG/zckcsd.f
TESTING/EIG/zcsdts.f
TESTING/LIN/cdrvgbx.f
TESTING/LIN/ddrvgbx.f
TESTING/LIN/derrsy.f
TESTING/LIN/dpot06.f
TESTING/LIN/serrsy.f
TESTING/LIN/zdrvac.f
TESTING/LIN/zdrvgbx.f
TESTING/LIN/zerrrfp.f
TESTING/MATGEN/claror.f
TESTING/MATGEN/dlaror.f
TESTING/MATGEN/dlatm7.f
TESTING/MATGEN/slaror.f
TESTING/MATGEN/zlaror.f

index d51169b..236719e 100644 (file)
@@ -4,6 +4,7 @@
 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
 *     November 2006
 *
+*  =====================================================================
 *     .. Local Scalars ..
       INTEGER            I1, I2
 *     ..
index 7d6403e..8e6270b 100644 (file)
@@ -72,7 +72,7 @@
       EXTERNAL           ILAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, MOD
+      INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
 *
index e1b4121..359e00e 100644 (file)
@@ -72,7 +72,7 @@
       EXTERNAL           ILAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, MOD
+      INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
 *
index 238ec11..c8b8900 100644 (file)
@@ -72,7 +72,7 @@
       EXTERNAL           ILAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, MOD
+      INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
 *
index 2dafefb..fede7e2 100644 (file)
@@ -72,7 +72,7 @@
       EXTERNAL           ILAENV
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, MOD
+      INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
 *
index 70686e0..93e0a5a 100644 (file)
@@ -81,7 +81,7 @@
       EXTERNAL           XERBLA
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, SQRT, LOG, INT, REAL, AIMAG
+      INTRINSIC          MAX, MIN, SQRT, LOG, INT
 *     ..
 *     .. Executable Statements ..
 *
index fd754ad..17e22a3 100644 (file)
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
+      EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, CSYTRF, CSYTRS, CSYTRS2
index 1c3fcbc..6123ba3 100644 (file)
       EXTERNAL           DNRM2, LSAME
 *     ..
 *     .. Intrinsic Functions
-      INTRINSIC          ATAN2, COS, MAX, MIN, SIN
+      INTRINSIC          ATAN2, COS, MAX, SIN
 *     ..
 *     .. Executable Statements ..
 *
index a4a0b18..ca5596d 100644 (file)
       EXTERNAL           LSAME
 *     ..
 *     .. Intrinsic Functions
-      INTRINSIC          COS, INT, MAX, MIN, SIN
+      INTRINSIC          INT, MAX, MIN
 *     ..
 *     .. Executable Statements ..
 *
index f719b40..ce16673 100644 (file)
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
+      EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, DSYTRF, DSYTRS, DSYTRS2
index 2d71bd4..9d8a8c7 100644 (file)
          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
index e9f86a0..f42bcf1 100644 (file)
 *     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
index 12511b3..9579efa 100644 (file)
          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
index 44902e4..0634b04 100644 (file)
          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
index eeaaab7..58f389b 100644 (file)
       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
index 0c9cedd..2ea05c3 100644 (file)
       EXTERNAL           SNRM2, LSAME
 *     ..
 *     .. Intrinsic Functions
-      INTRINSIC          ATAN2, COS, MAX, MIN, SIN
+      INTRINSIC          ATAN2, COS, MAX, SIN
 *     ..
 *     .. Executable Statements ..
 *
index e8dc968..306889e 100644 (file)
      $                     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,
index b4b3505..4f73e7a 100644 (file)
 *     ..
 *     .. 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
index a2931c6..32fe3e5 100644 (file)
       EXTERNAL           XERBLA
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, LOG, REAL, DIMAG
+      INTRINSIC          ABS, MAX, MIN, LOG, DBLE, DIMAG
 *     ..
 *     .. Statement Functions ..
       DOUBLE PRECISION   CABS1
index e027fe4..dd4a0da 100644 (file)
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
+      EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZSYTRF, ZSYTRS, ZSYTRS2
index aef0b0b..7370a65 100644 (file)
 *
          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
index e081652..f454e3c 100644 (file)
      $                   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 ..
 *
index 6054f5a..e4362fa 100644 (file)
       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 ) .
 *
index 3a2532e..5da0ccb 100644 (file)
@@ -35,8 +35,8 @@
 *     ..
 *     .. 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 ..
index 9981b4a..9fdd553 100644 (file)
      $                   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 ..
 *
index 83e5ab9..3b6762f 100644 (file)
       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.
index 9c768be..d6f4c22 100644 (file)
      $                   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 ..
 *
index 214a0d6..390c435 100644 (file)
       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.
index dd3547e..51f6a79 100644 (file)
 *
          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
index 8f43067..83b6304 100644 (file)
      $                   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 ..
 *
index 3436d9e..2aa7c44 100644 (file)
       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 ) .
 *
index 3ba557c..7bcb609 100644 (file)
@@ -723,9 +723,12 @@ c                     write(*,*) 'begin cgbsvxx testing'
                      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
@@ -778,7 +781,7 @@ c                     write(*,*) 'begin cgbsvxx testing'
 *                       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
@@ -792,8 +795,7 @@ c                     write(*,*) 'begin cgbsvxx testing'
                         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.
 *
index dc0be90..4be73fe 100644 (file)
      $                               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.
 *
index 3618681..8083b9e 100644 (file)
 *
          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
index d1c2df5..b5ca5ca 100644 (file)
       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
index 0f64e6d..7e218ef 100644 (file)
 *
          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
index e637598..04bdcf7 100644 (file)
 *     .. Local Variables ..
       INTEGER            ITER, KASE
 *     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAERH, ZLACPY, ZLAIPD,
      $                   ZLARHS, ZLATB4, ZLATMS, 
index 416dd75..2ef7b8a 100644 (file)
@@ -723,9 +723,12 @@ c                     write(*,*) 'begin zgbsvxx testing'
                      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
@@ -778,7 +781,7 @@ c                     write(*,*) 'begin zgbsvxx testing'
 *                       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
@@ -792,8 +795,7 @@ c                     write(*,*) 'begin zgbsvxx testing'
                         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.
 *
index 96b02db..078018c 100644 (file)
@@ -30,7 +30,8 @@
 *     ..
 *     .. 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'
index f1648be..d1d04d2 100644 (file)
 *     ..
 *     .. 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
index c844af7..468e37c 100644 (file)
 *     ..
 *     .. 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
index e21ad3c..683d46b 100644 (file)
 *
   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 )
index a18cdc1..4e5bef5 100644 (file)
 *     ..
 *     .. 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
index f739c7e..73f7513 100644 (file)
 *     ..
 *     .. 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