# HG changeset patch
# User jwe
# Date 941658892 0
# Node ID 15cddaacbc2d734004ebd52201d693233fce6025
# Parent  7c03933635c6fb0769a0a483df7b4f861fce7116
[project @ 1999-11-03 19:53:59 by jwe]

diff --git a/libcruft/ChangeLog b/libcruft/ChangeLog
--- a/libcruft/ChangeLog
+++ b/libcruft/ChangeLog
@@ -1,3 +1,9 @@
+1999-11-03  John W. Eaton  <jwe@bevo.che.wisc.edu>
+
+	* Update to Lapack version 3.0.
+	* lapack/ieeeck.f, lapack/dlasq2.f, lapack/dlasq3.f,
+	lapack/dlasq5.f, lapack/dlasq6.f: New files.
+
 1999-10-29  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
 	* misc/lo-error.cc (current_liboctave_warning_handler): Define	here.
diff --git a/libcruft/Makerules.in b/libcruft/Makerules.in
--- a/libcruft/Makerules.in
+++ b/libcruft/Makerules.in
@@ -14,7 +14,7 @@
 
 DISTFILES = Makefile.in $(SOURCES) $(SPECIAL)
 
-CRUFT_FSRC = $(wildcard $(srcdir)/*.f) \
+CRUFT_SRC = $(wildcard $(srcdir)/*.f) \
              $(wildcard $(srcdir)/*.c) \
              $(wildcard $(srcdir)/*.cc)
 CRUFT_BASE = $(basename $(notdir $(CRUFT_SRC)) )
diff --git a/libcruft/lapack/dbdsqr.f b/libcruft/lapack/dbdsqr.f
--- a/libcruft/lapack/dbdsqr.f
+++ b/libcruft/lapack/dbdsqr.f
@@ -1,10 +1,10 @@
       SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
      $                   LDU, C, LDC, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
@@ -152,9 +152,9 @@
       PARAMETER          ( MAXITR = 6 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            ROTATE
-      INTEGER            I, IDIR, IROT, ISUB, ITER, IUPLO, J, LL, LLL,
-     $                   M, MAXIT, NM1, NM12, NM13, OLDLL, OLDM
+      LOGICAL            LOWER, ROTATE
+      INTEGER            I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
+     $                   NM12, NM13, OLDLL, OLDM
       DOUBLE PRECISION   ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
      $                   OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
      $                   SINR, SLL, SMAX, SMIN, SMINL, SMINLO, SMINOA,
@@ -177,12 +177,8 @@
 *     Test the input parameters.
 *
       INFO = 0
-      IUPLO = 0
-      IF( LSAME( UPLO, 'U' ) )
-     $   IUPLO = 1
-      IF( LSAME( UPLO, 'L' ) )
-     $   IUPLO = 2
-      IF( IUPLO.EQ.0 ) THEN
+      LOWER = LSAME( UPLO, 'L' )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
@@ -208,7 +204,7 @@
       IF( N.EQ.0 )
      $   RETURN
       IF( N.EQ.1 )
-     $   GO TO 150
+     $   GO TO 160
 *
 *     ROTATE is true if any singular vectors desired, false otherwise
 *
@@ -224,6 +220,7 @@
       NM1 = N - 1
       NM12 = NM1 + NM1
       NM13 = NM12 + NM1
+      IDIR = 0
 *
 *     Get machine constants
 *
@@ -233,7 +230,7 @@
 *     If matrix lower bidiagonal, rotate to be upper bidiagonal
 *     by applying Givens rotations on the left
 *
-      IF( IUPLO.EQ.2 ) THEN
+      IF( LOWER ) THEN
          DO 10 I = 1, N - 1
             CALL DLARTG( D( I ), E( I ), CS, SN, R )
             D( I ) = R
@@ -262,10 +259,13 @@
 *
 *     Compute approximate maximum, minimum singular values
 *
-      SMAX = ABS( D( N ) )
-      DO 20 I = 1, N - 1
-         SMAX = MAX( SMAX, ABS( D( I ) ), ABS( E( I ) ) )
+      SMAX = ZERO
+      DO 20 I = 1, N
+         SMAX = MAX( SMAX, ABS( D( I ) ) )
    20 CONTINUE
+      DO 30 I = 1, N - 1
+         SMAX = MAX( SMAX, ABS( E( I ) ) )
+   30 CONTINUE
       SMINL = ZERO
       IF( TOL.GE.ZERO ) THEN
 *
@@ -273,15 +273,15 @@
 *
          SMINOA = ABS( D( 1 ) )
          IF( SMINOA.EQ.ZERO )
-     $      GO TO 40
+     $      GO TO 50
          MU = SMINOA
-         DO 30 I = 2, N
+         DO 40 I = 2, N
             MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
             SMINOA = MIN( SMINOA, MU )
             IF( SMINOA.EQ.ZERO )
-     $         GO TO 40
-   30    CONTINUE
+     $         GO TO 50
    40    CONTINUE
+   50    CONTINUE
          SMINOA = SMINOA / SQRT( DBLE( N ) )
          THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
       ELSE
@@ -306,14 +306,14 @@
 *
 *     Begin main iteration loop
 *
-   50 CONTINUE
+   60 CONTINUE
 *
 *     Check for convergence or exceeding iteration count
 *
       IF( M.LE.1 )
-     $   GO TO 150
+     $   GO TO 160
       IF( ITER.GT.MAXIT )
-     $   GO TO 190
+     $   GO TO 200
 *
 *     Find diagonal block of matrix to work on
 *
@@ -321,20 +321,20 @@
      $   D( M ) = ZERO
       SMAX = ABS( D( M ) )
       SMIN = SMAX
-      DO 60 LLL = 1, M
+      DO 70 LLL = 1, M - 1
          LL = M - LLL
-         IF( LL.EQ.0 )
-     $      GO TO 80
          ABSS = ABS( D( LL ) )
          ABSE = ABS( E( LL ) )
          IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
      $      D( LL ) = ZERO
          IF( ABSE.LE.THRESH )
-     $      GO TO 70
+     $      GO TO 80
          SMIN = MIN( SMIN, ABSS )
          SMAX = MAX( SMAX, ABSS, ABSE )
-   60 CONTINUE
    70 CONTINUE
+      LL = 0
+      GO TO 90
+   80 CONTINUE
       E( LL ) = ZERO
 *
 *     Matrix splits since E(LL) = 0
@@ -344,9 +344,9 @@
 *        Convergence of bottom singular value, return to top of loop
 *
          M = M - 1
-         GO TO 50
+         GO TO 60
       END IF
-   80 CONTINUE
+   90 CONTINUE
       LL = LL + 1
 *
 *     E(LL) through E(M-1) are nonzero, E(LL-1) is zero
@@ -372,7 +372,7 @@
      $      CALL DROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
      $                 SINL )
          M = M - 2
-         GO TO 50
+         GO TO 60
       END IF
 *
 *     If working on new submatrix, choose shift direction
@@ -402,7 +402,7 @@
          IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
      $       ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
             E( M-1 ) = ZERO
-            GO TO 50
+            GO TO 60
          END IF
 *
          IF( TOL.GE.ZERO ) THEN
@@ -412,15 +412,15 @@
 *
             MU = ABS( D( LL ) )
             SMINL = MU
-            DO 90 LLL = LL, M - 1
+            DO 100 LLL = LL, M - 1
                IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
                   E( LLL ) = ZERO
-                  GO TO 50
+                  GO TO 60
                END IF
                SMINLO = SMINL
                MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
                SMINL = MIN( SMINL, MU )
-   90       CONTINUE
+  100       CONTINUE
          END IF
 *
       ELSE
@@ -431,7 +431,7 @@
          IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
      $       ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
             E( LL ) = ZERO
-            GO TO 50
+            GO TO 60
          END IF
 *
          IF( TOL.GE.ZERO ) THEN
@@ -441,15 +441,15 @@
 *
             MU = ABS( D( M ) )
             SMINL = MU
-            DO 100 LLL = M - 1, LL, -1
+            DO 110 LLL = M - 1, LL, -1
                IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
                   E( LLL ) = ZERO
-                  GO TO 50
+                  GO TO 60
                END IF
                SMINLO = SMINL
                MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
                SMINL = MIN( SMINL, MU )
-  100       CONTINUE
+  110       CONTINUE
          END IF
       END IF
       OLDLL = LL
@@ -498,23 +498,16 @@
 *
             CS = ONE
             OLDCS = ONE
-            CALL DLARTG( D( LL )*CS, E( LL ), CS, SN, R )
-            CALL DLARTG( OLDCS*R, D( LL+1 )*SN, OLDCS, OLDSN, D( LL ) )
-            WORK( 1 ) = CS
-            WORK( 1+NM1 ) = SN
-            WORK( 1+NM12 ) = OLDCS
-            WORK( 1+NM13 ) = OLDSN
-            IROT = 1
-            DO 110 I = LL + 1, M - 1
+            DO 120 I = LL, M - 1
                CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
-               E( I-1 ) = OLDSN*R
+               IF( I.GT.LL )
+     $            E( I-1 ) = OLDSN*R
                CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
-               IROT = IROT + 1
-               WORK( IROT ) = CS
-               WORK( IROT+NM1 ) = SN
-               WORK( IROT+NM12 ) = OLDCS
-               WORK( IROT+NM13 ) = OLDSN
-  110       CONTINUE
+               WORK( I-LL+1 ) = CS
+               WORK( I-LL+1+NM1 ) = SN
+               WORK( I-LL+1+NM12 ) = OLDCS
+               WORK( I-LL+1+NM13 ) = OLDSN
+  120       CONTINUE
             H = D( M )*CS
             D( M ) = H*OLDCS
             E( M-1 ) = H*OLDSN
@@ -543,23 +536,16 @@
 *
             CS = ONE
             OLDCS = ONE
-            CALL DLARTG( D( M )*CS, E( M-1 ), CS, SN, R )
-            CALL DLARTG( OLDCS*R, D( M-1 )*SN, OLDCS, OLDSN, D( M ) )
-            WORK( M-LL ) = CS
-            WORK( M-LL+NM1 ) = -SN
-            WORK( M-LL+NM12 ) = OLDCS
-            WORK( M-LL+NM13 ) = -OLDSN
-            IROT = M - LL
-            DO 120 I = M - 1, LL + 1, -1
+            DO 130 I = M, LL + 1, -1
                CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
-               E( I ) = OLDSN*R
+               IF( I.LT.M )
+     $            E( I ) = OLDSN*R
                CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
-               IROT = IROT - 1
-               WORK( IROT ) = CS
-               WORK( IROT+NM1 ) = -SN
-               WORK( IROT+NM12 ) = OLDCS
-               WORK( IROT+NM13 ) = -OLDSN
-  120       CONTINUE
+               WORK( I-LL ) = CS
+               WORK( I-LL+NM1 ) = -SN
+               WORK( I-LL+NM12 ) = OLDCS
+               WORK( I-LL+NM13 ) = -OLDSN
+  130       CONTINUE
             H = D( LL )*CS
             D( LL ) = H*OLDCS
             E( LL ) = H*OLDSN
@@ -593,25 +579,10 @@
             F = ( ABS( D( LL ) )-SHIFT )*
      $          ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
             G = E( LL )
-            CALL DLARTG( F, G, COSR, SINR, R )
-            F = COSR*D( LL ) + SINR*E( LL )
-            E( LL ) = COSR*E( LL ) - SINR*D( LL )
-            G = SINR*D( LL+1 )
-            D( LL+1 ) = COSR*D( LL+1 )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( LL ) = R
-            F = COSL*E( LL ) + SINL*D( LL+1 )
-            D( LL+1 ) = COSL*D( LL+1 ) - SINL*E( LL )
-            G = SINL*E( LL+1 )
-            E( LL+1 ) = COSL*E( LL+1 )
-            WORK( 1 ) = COSR
-            WORK( 1+NM1 ) = SINR
-            WORK( 1+NM12 ) = COSL
-            WORK( 1+NM13 ) = SINL
-            IROT = 1
-            DO 130 I = LL + 1, M - 2
+            DO 140 I = LL, M - 1
                CALL DLARTG( F, G, COSR, SINR, R )
-               E( I-1 ) = R
+               IF( I.GT.LL )
+     $            E( I-1 ) = R
                F = COSR*D( I ) + SINR*E( I )
                E( I ) = COSR*E( I ) - SINR*D( I )
                G = SINR*D( I+1 )
@@ -620,29 +591,15 @@
                D( I ) = R
                F = COSL*E( I ) + SINL*D( I+1 )
                D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
-               G = SINL*E( I+1 )
-               E( I+1 ) = COSL*E( I+1 )
-               IROT = IROT + 1
-               WORK( IROT ) = COSR
-               WORK( IROT+NM1 ) = SINR
-               WORK( IROT+NM12 ) = COSL
-               WORK( IROT+NM13 ) = SINL
-  130       CONTINUE
-            CALL DLARTG( F, G, COSR, SINR, R )
-            E( M-2 ) = R
-            F = COSR*D( M-1 ) + SINR*E( M-1 )
-            E( M-1 ) = COSR*E( M-1 ) - SINR*D( M-1 )
-            G = SINR*D( M )
-            D( M ) = COSR*D( M )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( M-1 ) = R
-            F = COSL*E( M-1 ) + SINL*D( M )
-            D( M ) = COSL*D( M ) - SINL*E( M-1 )
-            IROT = IROT + 1
-            WORK( IROT ) = COSR
-            WORK( IROT+NM1 ) = SINR
-            WORK( IROT+NM12 ) = COSL
-            WORK( IROT+NM13 ) = SINL
+               IF( I.LT.M-1 ) THEN
+                  G = SINL*E( I+1 )
+                  E( I+1 ) = COSL*E( I+1 )
+               END IF
+               WORK( I-LL+1 ) = COSR
+               WORK( I-LL+1+NM1 ) = SINR
+               WORK( I-LL+1+NM12 ) = COSL
+               WORK( I-LL+1+NM13 ) = SINL
+  140       CONTINUE
             E( M-1 ) = F
 *
 *           Update singular vectors
@@ -670,25 +627,10 @@
             F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
      $          D( M ) )
             G = E( M-1 )
-            CALL DLARTG( F, G, COSR, SINR, R )
-            F = COSR*D( M ) + SINR*E( M-1 )
-            E( M-1 ) = COSR*E( M-1 ) - SINR*D( M )
-            G = SINR*D( M-1 )
-            D( M-1 ) = COSR*D( M-1 )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( M ) = R
-            F = COSL*E( M-1 ) + SINL*D( M-1 )
-            D( M-1 ) = COSL*D( M-1 ) - SINL*E( M-1 )
-            G = SINL*E( M-2 )
-            E( M-2 ) = COSL*E( M-2 )
-            WORK( M-LL ) = COSR
-            WORK( M-LL+NM1 ) = -SINR
-            WORK( M-LL+NM12 ) = COSL
-            WORK( M-LL+NM13 ) = -SINL
-            IROT = M - LL
-            DO 140 I = M - 1, LL + 2, -1
+            DO 150 I = M, LL + 1, -1
                CALL DLARTG( F, G, COSR, SINR, R )
-               E( I ) = R
+               IF( I.LT.M )
+     $            E( I ) = R
                F = COSR*D( I ) + SINR*E( I-1 )
                E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
                G = SINR*D( I-1 )
@@ -697,29 +639,15 @@
                D( I ) = R
                F = COSL*E( I-1 ) + SINL*D( I-1 )
                D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
-               G = SINL*E( I-2 )
-               E( I-2 ) = COSL*E( I-2 )
-               IROT = IROT - 1
-               WORK( IROT ) = COSR
-               WORK( IROT+NM1 ) = -SINR
-               WORK( IROT+NM12 ) = COSL
-               WORK( IROT+NM13 ) = -SINL
-  140       CONTINUE
-            CALL DLARTG( F, G, COSR, SINR, R )
-            E( LL+1 ) = R
-            F = COSR*D( LL+1 ) + SINR*E( LL )
-            E( LL ) = COSR*E( LL ) - SINR*D( LL+1 )
-            G = SINR*D( LL )
-            D( LL ) = COSR*D( LL )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( LL+1 ) = R
-            F = COSL*E( LL ) + SINL*D( LL )
-            D( LL ) = COSL*D( LL ) - SINL*E( LL )
-            IROT = IROT - 1
-            WORK( IROT ) = COSR
-            WORK( IROT+NM1 ) = -SINR
-            WORK( IROT+NM12 ) = COSL
-            WORK( IROT+NM13 ) = -SINL
+               IF( I.GT.LL+1 ) THEN
+                  G = SINL*E( I-2 )
+                  E( I-2 ) = COSL*E( I-2 )
+               END IF
+               WORK( I-LL ) = COSR
+               WORK( I-LL+NM1 ) = -SINR
+               WORK( I-LL+NM12 ) = COSL
+               WORK( I-LL+NM13 ) = -SINL
+  150       CONTINUE
             E( LL ) = F
 *
 *           Test convergence
@@ -743,12 +671,12 @@
 *
 *     QR iteration finished, go back and check convergence
 *
-      GO TO 50
+      GO TO 60
 *
 *     All singular values converged, so make them positive
 *
-  150 CONTINUE
-      DO 160 I = 1, N
+  160 CONTINUE
+      DO 170 I = 1, N
          IF( D( I ).LT.ZERO ) THEN
             D( I ) = -D( I )
 *
@@ -757,23 +685,23 @@
             IF( NCVT.GT.0 )
      $         CALL DSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
          END IF
-  160 CONTINUE
+  170 CONTINUE
 *
 *     Sort the singular values into decreasing order (insertion sort on
 *     singular values, but only one transposition per singular vector)
 *
-      DO 180 I = 1, N - 1
+      DO 190 I = 1, N - 1
 *
 *        Scan for smallest D(I)
 *
          ISUB = 1
          SMIN = D( 1 )
-         DO 170 J = 2, N + 1 - I
+         DO 180 J = 2, N + 1 - I
             IF( D( J ).LE.SMIN ) THEN
                ISUB = J
                SMIN = D( J )
             END IF
-  170    CONTINUE
+  180    CONTINUE
          IF( ISUB.NE.N+1-I ) THEN
 *
 *           Swap singular values and vectors
@@ -788,18 +716,18 @@
             IF( NCC.GT.0 )
      $         CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
          END IF
-  180 CONTINUE
-      GO TO 210
+  190 CONTINUE
+      GO TO 220
 *
 *     Maximum number of iterations exceeded, failure to converge
 *
-  190 CONTINUE
+  200 CONTINUE
       INFO = 0
-      DO 200 I = 1, N - 1
+      DO 210 I = 1, N - 1
          IF( E( I ).NE.ZERO )
      $      INFO = INFO + 1
-  200 CONTINUE
   210 CONTINUE
+  220 CONTINUE
       RETURN
 *
 *     End of DBDSQR
diff --git a/libcruft/lapack/dgebak.f b/libcruft/lapack/dgebak.f
--- a/libcruft/lapack/dgebak.f
+++ b/libcruft/lapack/dgebak.f
@@ -1,7 +1,7 @@
       SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
      $                   INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dgebal.f b/libcruft/lapack/dgebal.f
--- a/libcruft/lapack/dgebal.f
+++ b/libcruft/lapack/dgebal.f
@@ -1,9 +1,9 @@
       SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOB
@@ -96,13 +96,16 @@
 *
 *  This subroutine is based on the EISPACK routine BALANC.
 *
+*  Modified by Tzu-Yi Chen, Computer Science Division, University of
+*    California at Berkeley, USA
+*
 *  =====================================================================
 *
 *     .. Parameters ..
       DOUBLE PRECISION   ZERO, ONE
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
       DOUBLE PRECISION   SCLFAC
-      PARAMETER          ( SCLFAC = 1.0D+1 )
+      PARAMETER          ( SCLFAC = 0.8D+1 )
       DOUBLE PRECISION   FACTOR
       PARAMETER          ( FACTOR = 0.95D+0 )
 *     ..
diff --git a/libcruft/lapack/dgebd2.f b/libcruft/lapack/dgebd2.f
--- a/libcruft/lapack/dgebd2.f
+++ b/libcruft/lapack/dgebd2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dgebrd.f b/libcruft/lapack/dgebrd.f
--- a/libcruft/lapack/dgebrd.f
+++ b/libcruft/lapack/dgebrd.f
@@ -1,17 +1,17 @@
       SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
      $                   INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
       DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAUP( * ),
-     $                   TAUQ( * ), WORK( LWORK )
+     $                   TAUQ( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -78,6 +78,11 @@
 *          For optimum performance LWORK >= (M+N)*NB, where NB
 *          is the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
@@ -136,15 +141,16 @@
       PARAMETER          ( ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, MINMN, NB, NBMIN,
-     $                   NX
+      LOGICAL            LQUERY
+      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
+     $                   NBMIN, NX
       DOUBLE PRECISION   WS
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DGEBD2, DGEMM, DLABRD, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
+      INTRINSIC          DBLE, MAX, MIN
 *     ..
 *     .. External Functions ..
       INTEGER            ILAENV
@@ -155,18 +161,24 @@
 *     Test the input parameters
 *
       INFO = 0
+      NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
+      LWKOPT = ( M+N )*NB
+      WORK( 1 ) = DBLE( LWKOPT )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.LT.0 ) THEN
          CALL XERBLA( 'DGEBRD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -181,15 +193,14 @@
       LDWRKX = M
       LDWRKY = N
 *
-*     Set the block size NB and the crossover point NX.
+      IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
 *
-      NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
+*        Set the crossover point NX.
 *
-      IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
+         NX = MAX( NB, ILAENV( 3, 'DGEBRD', ' ', M, N, -1, -1 ) )
 *
 *        Determine when to switch from blocked to unblocked code.
 *
-         NX = MAX( NB, ILAENV( 3, 'DGEBRD', ' ', M, N, -1, -1 ) )
          IF( NX.LT.MINMN ) THEN
             WS = ( M+N )*NB
             IF( LWORK.LT.WS ) THEN
diff --git a/libcruft/lapack/dgeesx.f b/libcruft/lapack/dgeesx.f
--- a/libcruft/lapack/dgeesx.f
+++ b/libcruft/lapack/dgeesx.f
@@ -2,10 +2,10 @@
      $                   WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
      $                   IWORK, LIWORK, BWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     March 31, 1993
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBVS, SENSE, SORT
@@ -140,8 +140,9 @@
 *          N+2*SDIM*(N-SDIM) <= N+N*N/2.
 *          For good performance, LWORK must generally be larger.
 *
-*  IWORK   (workspace) INTEGER array, dimension (LIWORK)
+*  IWORK   (workspace/output) INTEGER array, dimension (LIWORK)
 *          Not referenced if SENSE = 'N' or 'E'.
+*          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
 *
 *  LIWORK  (input) INTEGER
 *          The dimension of the array IWORK.
@@ -185,8 +186,8 @@
       DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD,
-     $                   DLACPY, DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
+      EXTERNAL           DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY,
+     $                   DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
@@ -261,6 +262,9 @@
       IF( LWORK.LT.MINWRK ) THEN
          INFO = -16
       END IF
+      IF( LIWORK.LT.1 ) THEN
+         INFO = -18
+      END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DGEESX', -INFO )
          RETURN
@@ -485,6 +489,12 @@
       END IF
 *
       WORK( 1 ) = MAXWRK
+      IF( WANTSV .OR. WANTSB ) THEN
+         IWORK( 1 ) = SDIM*( N-SDIM )
+      ELSE
+         IWORK( 1 ) = 1
+      END IF
+*
       RETURN
 *
 *     End of DGEESX
diff --git a/libcruft/lapack/dgeev.f b/libcruft/lapack/dgeev.f
--- a/libcruft/lapack/dgeev.f
+++ b/libcruft/lapack/dgeev.f
@@ -1,10 +1,10 @@
       SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
      $                  LDVR, WORK, LWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBVL, JOBVR
@@ -98,6 +98,11 @@
 *          if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N.  For good
 *          performance, LWORK must generally be larger.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
@@ -113,7 +118,7 @@
       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            SCALEA, WANTVL, WANTVR
+      LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR
       CHARACTER          SIDE
       INTEGER            HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
      $                   MAXB, MAXWRK, MINWRK, NOUT
@@ -125,9 +130,8 @@
       DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
-     $                   DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
-     $                   XERBLA
+      EXTERNAL           DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG,
+     $                   DLASCL, DORGHR, DROT, DSCAL, DTREVC, XERBLA
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
@@ -144,6 +148,7 @@
 *     Test the input arguments
 *
       INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
       WANTVL = LSAME( JOBVL, 'V' )
       WANTVR = LSAME( JOBVR, 'V' )
       IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
@@ -193,12 +198,14 @@
          END IF
          WORK( 1 ) = MAXWRK
       END IF
-      IF( LWORK.LT.MINWRK ) THEN
+      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
          INFO = -13
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DGEEV ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
diff --git a/libcruft/lapack/dgehd2.f b/libcruft/lapack/dgehd2.f
--- a/libcruft/lapack/dgehd2.f
+++ b/libcruft/lapack/dgehd2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dgehrd.f b/libcruft/lapack/dgehrd.f
--- a/libcruft/lapack/dgehrd.f
+++ b/libcruft/lapack/dgehrd.f
@@ -1,15 +1,15 @@
       SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -56,6 +56,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
@@ -102,7 +107,9 @@
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, LDWORK, NB, NBMIN, NH, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, LDWORK, LWKOPT, NB, NBMIN,
+     $                   NH, NX
       DOUBLE PRECISION   EI
 *     ..
 *     .. Local Arrays ..
@@ -123,6 +130,10 @@
 *     Test the input parameters
 *
       INFO = 0
+      NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
+      LWKOPT = N*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( N.LT.0 ) THEN
          INFO = -1
       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
@@ -131,12 +142,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DGEHRD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
diff --git a/libcruft/lapack/dgelq2.f b/libcruft/lapack/dgelq2.f
--- a/libcruft/lapack/dgelq2.f
+++ b/libcruft/lapack/dgelq2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dgelqf.f b/libcruft/lapack/dgelqf.f
--- a/libcruft/lapack/dgelqf.f
+++ b/libcruft/lapack/dgelqf.f
@@ -1,15 +1,15 @@
       SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -50,6 +50,11 @@
 *          For optimum performance LWORK >= M*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -72,7 +77,9 @@
 *  =====================================================================
 *
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, NB, NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
+     $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DGELQ2, DLARFB, DLARFT, XERBLA
@@ -89,18 +96,24 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
+      LWKOPT = M*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DGELQF', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -111,9 +124,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
       NBMIN = 2
       NX = 0
       IWS = M
diff --git a/libcruft/lapack/dgelss.f b/libcruft/lapack/dgelss.f
--- a/libcruft/lapack/dgelss.f
+++ b/libcruft/lapack/dgelss.f
@@ -1,10 +1,10 @@
       SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
      $                   WORK, LWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -86,6 +86,11 @@
 *          LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
 *          For good performance, LWORK should generally be larger.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
@@ -97,9 +102,10 @@
 *
 *     .. Parameters ..
       DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
+      LOGICAL            LQUERY
       INTEGER            BDSPAC, BL, CHUNK, I, IASCL, IBSCL, IE, IL,
      $                   ITAU, ITAUP, ITAUQ, IWORK, LDWORK, MAXMN,
      $                   MAXWRK, MINMN, MINWRK, MM, MNTHR
@@ -129,6 +135,7 @@
       MINMN = MIN( M, N )
       MAXMN = MAX( M, N )
       MNTHR = ILAENV( 6, 'DGELSS', ' ', M, N, NRHS, -1 )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
@@ -149,7 +156,7 @@
 *       following subroutine, as returned by ILAENV.)
 *
       MINWRK = 1
-      IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
          MAXWRK = 0
          MM = M
          IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -166,7 +173,7 @@
 *
 *           Path 1 - overdetermined or exactly determined
 *
-*           Compute workspace neede for DBDSQR
+*           Compute workspace needed for DBDSQR
 *
             BDSPAC = MAX( 1, 5*N-4 )
             MAXWRK = MAX( MAXWRK, 3*N+( MM+N )*
@@ -182,7 +189,7 @@
          END IF
          IF( N.GT.M ) THEN
 *
-*           Compute workspace neede for DBDSQR
+*           Compute workspace needed for DBDSQR
 *
             BDSPAC = MAX( 1, 5*M-4 )
             MINWRK = MAX( 3*M+NRHS, 3*M+N, BDSPAC )
@@ -225,11 +232,13 @@
       END IF
 *
       MINWRK = MAX( MINWRK, 1 )
-      IF( LWORK.LT.MINWRK )
+      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
      $   INFO = -12
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DGELSS', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -385,9 +394,9 @@
             CHUNK = LWORK / N
             DO 20 I = 1, NRHS, CHUNK
                BL = MIN( NRHS-I+1, CHUNK )
-               CALL DGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B, LDB,
-     $                     ZERO, WORK, N )
-               CALL DLACPY( 'G', N, BL, WORK, N, B, LDB )
+               CALL DGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, I ),
+     $                     LDB, ZERO, WORK, N )
+               CALL DLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
    20       CONTINUE
          ELSE
             CALL DGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
@@ -483,7 +492,8 @@
                BL = MIN( NRHS-I+1, CHUNK )
                CALL DGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
      $                     B( 1, I ), LDB, ZERO, WORK( IWORK ), N )
-               CALL DLACPY( 'G', M, BL, WORK( IWORK ), N, B, LDB )
+               CALL DLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+     $                      LDB )
    40       CONTINUE
          ELSE
             CALL DGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
diff --git a/libcruft/lapack/dgeqpf.f b/libcruft/lapack/dgeqpf.f
--- a/libcruft/lapack/dgeqpf.f
+++ b/libcruft/lapack/dgeqpf.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
 *
-*  -- LAPACK test routine (version 2.0) --
+*  -- LAPACK test routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
@@ -16,6 +16,8 @@
 *  Purpose
 *  =======
 *
+*  This routine is deprecated and has been replaced by routine DGEQP3.
+*
 *  DGEQPF computes a QR factorization with column pivoting of a
 *  real M-by-N matrix A: A*P = Q*R.
 *
diff --git a/libcruft/lapack/dgeqr2.f b/libcruft/lapack/dgeqr2.f
--- a/libcruft/lapack/dgeqr2.f
+++ b/libcruft/lapack/dgeqr2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dgeqrf.f b/libcruft/lapack/dgeqrf.f
--- a/libcruft/lapack/dgeqrf.f
+++ b/libcruft/lapack/dgeqrf.f
@@ -1,15 +1,15 @@
       SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -51,6 +51,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -73,7 +78,9 @@
 *  =====================================================================
 *
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, NB, NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
+     $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DGEQR2, DLARFB, DLARFT, XERBLA
@@ -90,18 +97,24 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
+      LWKOPT = N*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DGEQRF', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -112,9 +125,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
       NBMIN = 2
       NX = 0
       IWS = N
diff --git a/libcruft/lapack/dgesv.f b/libcruft/lapack/dgesv.f
--- a/libcruft/lapack/dgesv.f
+++ b/libcruft/lapack/dgesv.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
diff --git a/libcruft/lapack/dgesvd.f b/libcruft/lapack/dgesvd.f
--- a/libcruft/lapack/dgesvd.f
+++ b/libcruft/lapack/dgesvd.f
@@ -1,10 +1,10 @@
       SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
      $                   WORK, LWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBU, JOBVT
@@ -118,6 +118,11 @@
 *          LWORK >= MAX(3*MIN(M,N)+MAX(M,N),5*MIN(M,N)-4).
 *          For good performance, LWORK should generally be larger.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit.
 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
@@ -133,8 +138,8 @@
       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS, WNTVA,
-     $                   WNTVAS, WNTVN, WNTVO, WNTVS
+      LOGICAL            LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
+     $                   WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
       INTEGER            BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
      $                   ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
      $                   MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
@@ -176,6 +181,7 @@
       WNTVO = LSAME( JOBVT, 'O' )
       WNTVN = LSAME( JOBVT, 'N' )
       MINWRK = 1
+      LQUERY = ( LWORK.EQ.-1 )
 *
       IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
          INFO = -1
@@ -202,7 +208,8 @@
 *       NB refers to the optimal block size for the immediately
 *       following subroutine, as returned by ILAENV.)
 *
-      IF( INFO.EQ.0 .AND. LWORK.GE.1 .AND. M.GT.0 .AND. N.GT.0 ) THEN
+      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
+     $    N.GT.0 ) THEN
          IF( M.GE.N ) THEN
 *
 *           Compute space needed for DBDSQR
@@ -553,12 +560,14 @@
          WORK( 1 ) = MAXWRK
       END IF
 *
-      IF( LWORK.LT.MINWRK ) THEN
+      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
          INFO = -13
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DGESVD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
diff --git a/libcruft/lapack/dgetf2.f b/libcruft/lapack/dgetf2.f
--- a/libcruft/lapack/dgetf2.f
+++ b/libcruft/lapack/dgetf2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     June 30, 1992
diff --git a/libcruft/lapack/dgetrf.f b/libcruft/lapack/dgetrf.f
--- a/libcruft/lapack/dgetrf.f
+++ b/libcruft/lapack/dgetrf.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
diff --git a/libcruft/lapack/dgetrs.f b/libcruft/lapack/dgetrs.f
--- a/libcruft/lapack/dgetrs.f
+++ b/libcruft/lapack/dgetrs.f
@@ -1,6 +1,6 @@
       SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
diff --git a/libcruft/lapack/dggbak.f b/libcruft/lapack/dggbak.f
--- a/libcruft/lapack/dggbak.f
+++ b/libcruft/lapack/dggbak.f
@@ -1,7 +1,7 @@
       SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
      $                   LDV, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dggbal.f b/libcruft/lapack/dggbal.f
--- a/libcruft/lapack/dggbal.f
+++ b/libcruft/lapack/dggbal.f
@@ -1,7 +1,7 @@
       SUBROUTINE DGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
      $                   RSCALE, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dgghrd.f b/libcruft/lapack/dgghrd.f
--- a/libcruft/lapack/dgghrd.f
+++ b/libcruft/lapack/dgghrd.f
@@ -1,7 +1,7 @@
       SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
      $                   LDQ, Z, LDZ, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dhgeqz.f b/libcruft/lapack/dhgeqz.f
--- a/libcruft/lapack/dhgeqz.f
+++ b/libcruft/lapack/dhgeqz.f
@@ -2,10 +2,10 @@
      $                   ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
      $                   LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          COMPQ, COMPZ, JOB
@@ -179,6 +179,11 @@
 *  LWORK   (input) INTEGER
 *          The dimension of the array WORK.  LWORK >= max(1,N).
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0: successful exit
 *          < 0: if INFO = -i, the i-th argument had an illegal value
@@ -209,7 +214,8 @@
      $                   SAFETY = 1.0D+2 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            ILAZR2, ILAZRO, ILPIVT, ILQ, ILSCHR, ILZ
+      LOGICAL            ILAZR2, ILAZRO, ILPIVT, ILQ, ILSCHR, ILZ,
+     $                   LQUERY
       INTEGER            ICOMPQ, ICOMPZ, IFIRST, IFRSTM, IITER, ILAST,
      $                   ILASTM, IN, ISCHUR, ISTART, J, JC, JCH, JITER,
      $                   JR, MAXIT
@@ -282,6 +288,8 @@
 *     Check Argument Values
 *
       INFO = 0
+      WORK( 1 ) = MAX( 1, N )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( ISCHUR.EQ.0 ) THEN
          INFO = -1
       ELSE IF( ICOMPQ.EQ.0 ) THEN
@@ -302,12 +310,14 @@
          INFO = -15
       ELSE IF( LDZ.LT.1 .OR. ( ILZ .AND. LDZ.LT.N ) ) THEN
          INFO = -17
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -19
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DHGEQZ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
diff --git a/libcruft/lapack/dhseqr.f b/libcruft/lapack/dhseqr.f
--- a/libcruft/lapack/dhseqr.f
+++ b/libcruft/lapack/dhseqr.f
@@ -1,10 +1,10 @@
       SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
      $                   LDZ, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          COMPZ, JOB
@@ -93,10 +93,16 @@
 *          The leading dimension of the array Z.
 *          LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise.
 *
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
+*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *
 *  LWORK   (input) INTEGER
-*          This argument is currently redundant.
+*          The dimension of the array WORK.  LWORK >= max(1,N).
+*
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
 *
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
@@ -117,7 +123,7 @@
       PARAMETER          ( NSMAX = 15, LDS = NSMAX )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            INITZ, WANTT, WANTZ
+      LOGICAL            INITZ, LQUERY, WANTT, WANTZ
       INTEGER            I, I1, I2, IERR, II, ITEMP, ITN, ITS, J, K, L,
      $                   MAXB, NH, NR, NS, NV
       DOUBLE PRECISION   ABSW, OVFL, SMLNUM, TAU, TEMP, TST1, ULP, UNFL
@@ -132,8 +138,8 @@
       EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DLANHS, DLAPY2
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEMV, DLABAD, DLACPY, DLAHQR, DLARFG,
-     $                   DLARFX, DLASET, DSCAL, XERBLA
+      EXTERNAL           DCOPY, DGEMV, DLACPY, DLAHQR, DLARFG, DLARFX,
+     $                   DLASET, DSCAL, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, MAX, MIN
@@ -147,6 +153,8 @@
       WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
 *
       INFO = 0
+      WORK( 1 ) = MAX( 1, N )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
          INFO = -1
       ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
@@ -161,10 +169,14 @@
          INFO = -7
       ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. LDZ.LT.MAX( 1, N ) ) THEN
          INFO = -11
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+         INFO = -13
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DHSEQR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Initialize Z, if necessary
@@ -447,6 +459,7 @@
       GO TO 50
 *
   170 CONTINUE
+      WORK( 1 ) = MAX( 1, N )
       RETURN
 *
 *     End of DHSEQR
diff --git a/libcruft/lapack/dlabad.f b/libcruft/lapack/dlabad.f
--- a/libcruft/lapack/dlabad.f
+++ b/libcruft/lapack/dlabad.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLABAD( SMALL, LARGE )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
@@ -12,7 +12,7 @@
 *  Purpose
 *  =======
 *
-*  DLABAD takes as input the values computed by SLAMCH for underflow and
+*  DLABAD takes as input the values computed by DLAMCH for underflow and
 *  overflow, and returns the square root of each of these values if the
 *  log of LARGE is sufficiently large.  This subroutine is intended to
 *  identify machines with a large exponent range, such as the Crays, and
diff --git a/libcruft/lapack/dlabrd.f b/libcruft/lapack/dlabrd.f
--- a/libcruft/lapack/dlabrd.f
+++ b/libcruft/lapack/dlabrd.f
@@ -1,7 +1,7 @@
       SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
      $                   LDY )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlacon.f b/libcruft/lapack/dlacon.f
--- a/libcruft/lapack/dlacon.f
+++ b/libcruft/lapack/dlacon.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlacpy.f b/libcruft/lapack/dlacpy.f
--- a/libcruft/lapack/dlacpy.f
+++ b/libcruft/lapack/dlacpy.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dladiv.f b/libcruft/lapack/dladiv.f
--- a/libcruft/lapack/dladiv.f
+++ b/libcruft/lapack/dladiv.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLADIV( A, B, C, D, P, Q )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlae2.f b/libcruft/lapack/dlae2.f
--- a/libcruft/lapack/dlae2.f
+++ b/libcruft/lapack/dlae2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLAE2( A, B, C, RT1, RT2 )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlaev2.f b/libcruft/lapack/dlaev2.f
--- a/libcruft/lapack/dlaev2.f
+++ b/libcruft/lapack/dlaev2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlaexc.f b/libcruft/lapack/dlaexc.f
--- a/libcruft/lapack/dlaexc.f
+++ b/libcruft/lapack/dlaexc.f
@@ -1,7 +1,7 @@
       SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
      $                   INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlag2.f b/libcruft/lapack/dlag2.f
--- a/libcruft/lapack/dlag2.f
+++ b/libcruft/lapack/dlag2.f
@@ -1,7 +1,7 @@
       SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
      $                  WR2, WI )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
diff --git a/libcruft/lapack/dlahqr.f b/libcruft/lapack/dlahqr.f
--- a/libcruft/lapack/dlahqr.f
+++ b/libcruft/lapack/dlahqr.f
@@ -1,10 +1,10 @@
       SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
      $                   ILOZ, IHIZ, Z, LDZ, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       LOGICAL            WANTT, WANTZ
@@ -90,19 +90,26 @@
 *               elements i+1:ihi of WR and WI contain those eigenvalues
 *               which have been successfully computed.
 *
+*  Further Details
+*  ===============
+*
+*  2-96 Based on modifications by
+*     David Day, Sandia National Laboratory, USA
+*
 *  =====================================================================
 *
 *     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   ZERO, ONE, HALF
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, HALF = 0.5D0 )
       DOUBLE PRECISION   DAT1, DAT2
       PARAMETER          ( DAT1 = 0.75D+0, DAT2 = -0.4375D+0 )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, I1, I2, ITN, ITS, J, K, L, M, NH, NR, NZ
-      DOUBLE PRECISION   CS, H00, H10, H11, H12, H21, H22, H33, H33S,
-     $                   H43H34, H44, H44S, OVFL, S, SMLNUM, SN, SUM,
-     $                   T1, T2, T3, TST1, ULP, UNFL, V1, V2, V3
+      DOUBLE PRECISION   AVE, CS, DISC, H00, H10, H11, H12, H21, H22,
+     $                   H33, H33S, H43H34, H44, H44S, OVFL, S, SMLNUM,
+     $                   SN, SUM, T1, T2, T3, TST1, ULP, UNFL, V1, V2,
+     $                   V3
 *     ..
 *     .. Local Arrays ..
       DOUBLE PRECISION   V( 3 ), WORK( 1 )
@@ -112,10 +119,10 @@
       EXTERNAL           DLAMCH, DLANHS
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DCOPY, DLABAD, DLANV2, DLARFG, DROT
+      EXTERNAL           DCOPY, DLANV2, DLARFG, DROT
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
+      INTRINSIC          ABS, MAX, MIN, SIGN, SQRT
 *     ..
 *     .. Executable Statements ..
 *
@@ -211,22 +218,40 @@
 *           Exceptional shift.
 *
             S = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
-            H44 = DAT1*S
+            H44 = DAT1*S + H( I, I )
             H33 = H44
             H43H34 = DAT2*S*S
          ELSE
 *
-*           Prepare to use Wilkinson's double shift
+*           Prepare to use Francis' double shift
+*           (i.e. 2nd degree generalized Rayleigh quotient)
 *
             H44 = H( I, I )
             H33 = H( I-1, I-1 )
             H43H34 = H( I, I-1 )*H( I-1, I )
+            S = H( I-1, I-2 )*H( I-1, I-2 )
+            DISC = ( H33-H44 )*HALF
+            DISC = DISC*DISC + H43H34
+            IF( DISC.GT.ZERO ) THEN
+*
+*              Real roots: use Wilkinson's shift twice
+*
+               DISC = SQRT( DISC )
+               AVE = HALF*( H33+H44 )
+               IF( ABS( H33 )-ABS( H44 ).GT.ZERO ) THEN
+                  H33 = H33*H44 - H43H34
+                  H44 = H33 / ( SIGN( DISC, AVE )+AVE )
+               ELSE
+                  H44 = SIGN( DISC, AVE ) + AVE
+               END IF
+               H33 = H44
+               H43H34 = ZERO
+            END IF
          END IF
 *
 *        Look for two consecutive small subdiagonal elements.
 *
          DO 40 M = I - 2, L, -1
-*
 *           Determine the effect of starting the double-shift QR
 *           iteration at row M, and see if this would make H(M,M-1)
 *           negligible.
diff --git a/libcruft/lapack/dlahrd.f b/libcruft/lapack/dlahrd.f
--- a/libcruft/lapack/dlahrd.f
+++ b/libcruft/lapack/dlahrd.f
@@ -1,9 +1,9 @@
       SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     February 29, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            K, LDA, LDT, LDY, N, NB
@@ -53,7 +53,7 @@
 *          The scalar factors of the elementary reflectors. See Further
 *          Details.
 *
-*  T       (output) DOUBLE PRECISION array, dimension (NB,NB)
+*  T       (output) DOUBLE PRECISION array, dimension (LDT,NB)
 *          The upper triangular matrix T.
 *
 *  LDT     (input) INTEGER
diff --git a/libcruft/lapack/dlaln2.f b/libcruft/lapack/dlaln2.f
--- a/libcruft/lapack/dlaln2.f
+++ b/libcruft/lapack/dlaln2.f
@@ -1,7 +1,7 @@
       SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
      $                   LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlamch.f b/libcruft/lapack/dlamch.f
--- a/libcruft/lapack/dlamch.f
+++ b/libcruft/lapack/dlamch.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
@@ -125,3 +125,733 @@
 *     End of DLAMCH
 *
       END
+*
+************************************************************************
+*
+      SUBROUTINE DLAMC1( BETA, T, RND, IEEE1 )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     October 31, 1992
+*
+*     .. Scalar Arguments ..
+      LOGICAL            IEEE1, RND
+      INTEGER            BETA, T
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DLAMC1 determines the machine parameters given by BETA, T, RND, and
+*  IEEE1.
+*
+*  Arguments
+*  =========
+*
+*  BETA    (output) INTEGER
+*          The base of the machine.
+*
+*  T       (output) INTEGER
+*          The number of ( BETA ) digits in the mantissa.
+*
+*  RND     (output) LOGICAL
+*          Specifies whether proper rounding  ( RND = .TRUE. )  or
+*          chopping  ( RND = .FALSE. )  occurs in addition. This may not
+*          be a reliable guide to the way in which the machine performs
+*          its arithmetic.
+*
+*  IEEE1   (output) LOGICAL
+*          Specifies whether rounding appears to be done in the IEEE
+*          'round to nearest' style.
+*
+*  Further Details
+*  ===============
+*
+*  The routine is based on the routine  ENVRON  by Malcolm and
+*  incorporates suggestions by Gentleman and Marovich. See
+*
+*     Malcolm M. A. (1972) Algorithms to reveal properties of
+*        floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+*
+*     Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+*        that reveal properties of floating point arithmetic units.
+*        Comms. of the ACM, 17, 276-277.
+*
+* =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            FIRST, LIEEE1, LRND
+      INTEGER            LBETA, LT
+      DOUBLE PRECISION   A, B, C, F, ONE, QTR, SAVEC, T1, T2
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMC3
+      EXTERNAL           DLAMC3
+*     ..
+*     .. Save statement ..
+      SAVE               FIRST, LIEEE1, LBETA, LRND, LT
+*     ..
+*     .. Data statements ..
+      DATA               FIRST / .TRUE. /
+*     ..
+*     .. Executable Statements ..
+*
+      IF( FIRST ) THEN
+         FIRST = .FALSE.
+         ONE = 1
+*
+*        LBETA,  LIEEE1,  LT and  LRND  are the  local values  of  BETA,
+*        IEEE1, T and RND.
+*
+*        Throughout this routine  we use the function  DLAMC3  to ensure
+*        that relevant values are  stored and not held in registers,  or
+*        are not affected by optimizers.
+*
+*        Compute  a = 2.0**m  with the  smallest positive integer m such
+*        that
+*
+*           fl( a + 1.0 ) = a.
+*
+         A = 1
+         C = 1
+*
+*+       WHILE( C.EQ.ONE )LOOP
+   10    CONTINUE
+         IF( C.EQ.ONE ) THEN
+            A = 2*A
+            C = DLAMC3( A, ONE )
+            C = DLAMC3( C, -A )
+            GO TO 10
+         END IF
+*+       END WHILE
+*
+*        Now compute  b = 2.0**m  with the smallest positive integer m
+*        such that
+*
+*           fl( a + b ) .gt. a.
+*
+         B = 1
+         C = DLAMC3( A, B )
+*
+*+       WHILE( C.EQ.A )LOOP
+   20    CONTINUE
+         IF( C.EQ.A ) THEN
+            B = 2*B
+            C = DLAMC3( A, B )
+            GO TO 20
+         END IF
+*+       END WHILE
+*
+*        Now compute the base.  a and c  are neighbouring floating point
+*        numbers  in the  interval  ( beta**t, beta**( t + 1 ) )  and so
+*        their difference is beta. Adding 0.25 to c is to ensure that it
+*        is truncated to beta and not ( beta - 1 ).
+*
+         QTR = ONE / 4
+         SAVEC = C
+         C = DLAMC3( C, -A )
+         LBETA = C + QTR
+*
+*        Now determine whether rounding or chopping occurs,  by adding a
+*        bit  less  than  beta/2  and a  bit  more  than  beta/2  to  a.
+*
+         B = LBETA
+         F = DLAMC3( B / 2, -B / 100 )
+         C = DLAMC3( F, A )
+         IF( C.EQ.A ) THEN
+            LRND = .TRUE.
+         ELSE
+            LRND = .FALSE.
+         END IF
+         F = DLAMC3( B / 2, B / 100 )
+         C = DLAMC3( F, A )
+         IF( ( LRND ) .AND. ( C.EQ.A ) )
+     $      LRND = .FALSE.
+*
+*        Try and decide whether rounding is done in the  IEEE  'round to
+*        nearest' style. B/2 is half a unit in the last place of the two
+*        numbers A and SAVEC. Furthermore, A is even, i.e. has last  bit
+*        zero, and SAVEC is odd. Thus adding B/2 to A should not  change
+*        A, but adding B/2 to SAVEC should change SAVEC.
+*
+         T1 = DLAMC3( B / 2, A )
+         T2 = DLAMC3( B / 2, SAVEC )
+         LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
+*
+*        Now find  the  mantissa, t.  It should  be the  integer part of
+*        log to the base beta of a,  however it is safer to determine  t
+*        by powering.  So we find t as the smallest positive integer for
+*        which
+*
+*           fl( beta**t + 1.0 ) = 1.0.
+*
+         LT = 0
+         A = 1
+         C = 1
+*
+*+       WHILE( C.EQ.ONE )LOOP
+   30    CONTINUE
+         IF( C.EQ.ONE ) THEN
+            LT = LT + 1
+            A = A*LBETA
+            C = DLAMC3( A, ONE )
+            C = DLAMC3( C, -A )
+            GO TO 30
+         END IF
+*+       END WHILE
+*
+      END IF
+*
+      BETA = LBETA
+      T = LT
+      RND = LRND
+      IEEE1 = LIEEE1
+      RETURN
+*
+*     End of DLAMC1
+*
+      END
+*
+************************************************************************
+*
+      SUBROUTINE DLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     October 31, 1992
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RND
+      INTEGER            BETA, EMAX, EMIN, T
+      DOUBLE PRECISION   EPS, RMAX, RMIN
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DLAMC2 determines the machine parameters specified in its argument
+*  list.
+*
+*  Arguments
+*  =========
+*
+*  BETA    (output) INTEGER
+*          The base of the machine.
+*
+*  T       (output) INTEGER
+*          The number of ( BETA ) digits in the mantissa.
+*
+*  RND     (output) LOGICAL
+*          Specifies whether proper rounding  ( RND = .TRUE. )  or
+*          chopping  ( RND = .FALSE. )  occurs in addition. This may not
+*          be a reliable guide to the way in which the machine performs
+*          its arithmetic.
+*
+*  EPS     (output) DOUBLE PRECISION
+*          The smallest positive number such that
+*
+*             fl( 1.0 - EPS ) .LT. 1.0,
+*
+*          where fl denotes the computed value.
+*
+*  EMIN    (output) INTEGER
+*          The minimum exponent before (gradual) underflow occurs.
+*
+*  RMIN    (output) DOUBLE PRECISION
+*          The smallest normalized number for the machine, given by
+*          BASE**( EMIN - 1 ), where  BASE  is the floating point value
+*          of BETA.
+*
+*  EMAX    (output) INTEGER
+*          The maximum exponent before overflow occurs.
+*
+*  RMAX    (output) DOUBLE PRECISION
+*          The largest positive number for the machine, given by
+*          BASE**EMAX * ( 1 - EPS ), where  BASE  is the floating point
+*          value of BETA.
+*
+*  Further Details
+*  ===============
+*
+*  The computation of  EPS  is based on a routine PARANOIA by
+*  W. Kahan of the University of California at Berkeley.
+*
+* =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            FIRST, IEEE, IWARN, LIEEE1, LRND
+      INTEGER            GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
+     $                   NGNMIN, NGPMIN
+      DOUBLE PRECISION   A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
+     $                   SIXTH, SMALL, THIRD, TWO, ZERO
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMC3
+      EXTERNAL           DLAMC3
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLAMC1, DLAMC4, DLAMC5
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     ..
+*     .. Save statement ..
+      SAVE               FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
+     $                   LRMIN, LT
+*     ..
+*     .. Data statements ..
+      DATA               FIRST / .TRUE. / , IWARN / .FALSE. /
+*     ..
+*     .. Executable Statements ..
+*
+      IF( FIRST ) THEN
+         FIRST = .FALSE.
+         ZERO = 0
+         ONE = 1
+         TWO = 2
+*
+*        LBETA, LT, LRND, LEPS, LEMIN and LRMIN  are the local values of
+*        BETA, T, RND, EPS, EMIN and RMIN.
+*
+*        Throughout this routine  we use the function  DLAMC3  to ensure
+*        that relevant values are stored  and not held in registers,  or
+*        are not affected by optimizers.
+*
+*        DLAMC1 returns the parameters  LBETA, LT, LRND and LIEEE1.
+*
+         CALL DLAMC1( LBETA, LT, LRND, LIEEE1 )
+*
+*        Start to find EPS.
+*
+         B = LBETA
+         A = B**( -LT )
+         LEPS = A
+*
+*        Try some tricks to see whether or not this is the correct  EPS.
+*
+         B = TWO / 3
+         HALF = ONE / 2
+         SIXTH = DLAMC3( B, -HALF )
+         THIRD = DLAMC3( SIXTH, SIXTH )
+         B = DLAMC3( THIRD, -HALF )
+         B = DLAMC3( B, SIXTH )
+         B = ABS( B )
+         IF( B.LT.LEPS )
+     $      B = LEPS
+*
+         LEPS = 1
+*
+*+       WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
+   10    CONTINUE
+         IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
+            LEPS = B
+            C = DLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
+            C = DLAMC3( HALF, -C )
+            B = DLAMC3( HALF, C )
+            C = DLAMC3( HALF, -B )
+            B = DLAMC3( HALF, C )
+            GO TO 10
+         END IF
+*+       END WHILE
+*
+         IF( A.LT.LEPS )
+     $      LEPS = A
+*
+*        Computation of EPS complete.
+*
+*        Now find  EMIN.  Let A = + or - 1, and + or - (1 + BASE**(-3)).
+*        Keep dividing  A by BETA until (gradual) underflow occurs. This
+*        is detected when we cannot recover the previous A.
+*
+         RBASE = ONE / LBETA
+         SMALL = ONE
+         DO 20 I = 1, 3
+            SMALL = DLAMC3( SMALL*RBASE, ZERO )
+   20    CONTINUE
+         A = DLAMC3( ONE, SMALL )
+         CALL DLAMC4( NGPMIN, ONE, LBETA )
+         CALL DLAMC4( NGNMIN, -ONE, LBETA )
+         CALL DLAMC4( GPMIN, A, LBETA )
+         CALL DLAMC4( GNMIN, -A, LBETA )
+         IEEE = .FALSE.
+*
+         IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
+            IF( NGPMIN.EQ.GPMIN ) THEN
+               LEMIN = NGPMIN
+*            ( Non twos-complement machines, no gradual underflow;
+*              e.g.,  VAX )
+            ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
+               LEMIN = NGPMIN - 1 + LT
+               IEEE = .TRUE.
+*            ( Non twos-complement machines, with gradual underflow;
+*              e.g., IEEE standard followers )
+            ELSE
+               LEMIN = MIN( NGPMIN, GPMIN )
+*            ( A guess; no known machine )
+               IWARN = .TRUE.
+            END IF
+*
+         ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
+            IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
+               LEMIN = MAX( NGPMIN, NGNMIN )
+*            ( Twos-complement machines, no gradual underflow;
+*              e.g., CYBER 205 )
+            ELSE
+               LEMIN = MIN( NGPMIN, NGNMIN )
+*            ( A guess; no known machine )
+               IWARN = .TRUE.
+            END IF
+*
+         ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
+     $            ( GPMIN.EQ.GNMIN ) ) THEN
+            IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
+               LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
+*            ( Twos-complement machines with gradual underflow;
+*              no known machine )
+            ELSE
+               LEMIN = MIN( NGPMIN, NGNMIN )
+*            ( A guess; no known machine )
+               IWARN = .TRUE.
+            END IF
+*
+         ELSE
+            LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
+*         ( A guess; no known machine )
+            IWARN = .TRUE.
+         END IF
+***
+* Comment out this if block if EMIN is ok
+         IF( IWARN ) THEN
+            FIRST = .TRUE.
+            WRITE( 6, FMT = 9999 )LEMIN
+         END IF
+***
+*
+*        Assume IEEE arithmetic if we found denormalised  numbers above,
+*        or if arithmetic seems to round in the  IEEE style,  determined
+*        in routine DLAMC1. A true IEEE machine should have both  things
+*        true; however, faulty machines may have one or the other.
+*
+         IEEE = IEEE .OR. LIEEE1
+*
+*        Compute  RMIN by successive division by  BETA. We could compute
+*        RMIN as BASE**( EMIN - 1 ),  but some machines underflow during
+*        this computation.
+*
+         LRMIN = 1
+         DO 30 I = 1, 1 - LEMIN
+            LRMIN = DLAMC3( LRMIN*RBASE, ZERO )
+   30    CONTINUE
+*
+*        Finally, call DLAMC5 to compute EMAX and RMAX.
+*
+         CALL DLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
+      END IF
+*
+      BETA = LBETA
+      T = LT
+      RND = LRND
+      EPS = LEPS
+      EMIN = LEMIN
+      RMIN = LRMIN
+      EMAX = LEMAX
+      RMAX = LRMAX
+*
+      RETURN
+*
+ 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
+     $      '  EMIN = ', I8, /
+     $      ' If, after inspection, the value EMIN looks',
+     $      ' acceptable please comment out ',
+     $      / ' the IF block as marked within the code of routine',
+     $      ' DLAMC2,', / ' otherwise supply EMIN explicitly.', / )
+*
+*     End of DLAMC2
+*
+      END
+*
+************************************************************************
+*
+      DOUBLE PRECISION FUNCTION DLAMC3( A, B )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     October 31, 1992
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   A, B
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DLAMC3  is intended to force  A  and  B  to be stored prior to doing
+*  the addition of  A  and  B ,  for use in situations where optimizers
+*  might hold one of these in a register.
+*
+*  Arguments
+*  =========
+*
+*  A, B    (input) DOUBLE PRECISION
+*          The values A and B.
+*
+* =====================================================================
+*
+*     .. Executable Statements ..
+*
+      DLAMC3 = A + B
+*
+      RETURN
+*
+*     End of DLAMC3
+*
+      END
+*
+************************************************************************
+*
+      SUBROUTINE DLAMC4( EMIN, START, BASE )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     October 31, 1992
+*
+*     .. Scalar Arguments ..
+      INTEGER            BASE, EMIN
+      DOUBLE PRECISION   START
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DLAMC4 is a service routine for DLAMC2.
+*
+*  Arguments
+*  =========
+*
+*  EMIN    (output) EMIN
+*          The minimum exponent before (gradual) underflow, computed by
+*          setting A = START and dividing by BASE until the previous A
+*          can not be recovered.
+*
+*  START   (input) DOUBLE PRECISION
+*          The starting point for determining EMIN.
+*
+*  BASE    (input) INTEGER
+*          The base of the machine.
+*
+* =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER            I
+      DOUBLE PRECISION   A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMC3
+      EXTERNAL           DLAMC3
+*     ..
+*     .. Executable Statements ..
+*
+      A = START
+      ONE = 1
+      RBASE = ONE / BASE
+      ZERO = 0
+      EMIN = 1
+      B1 = DLAMC3( A*RBASE, ZERO )
+      C1 = A
+      C2 = A
+      D1 = A
+      D2 = A
+*+    WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
+*    $       ( D1.EQ.A ).AND.( D2.EQ.A )      )LOOP
+   10 CONTINUE
+      IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
+     $    ( D2.EQ.A ) ) THEN
+         EMIN = EMIN - 1
+         A = B1
+         B1 = DLAMC3( A / BASE, ZERO )
+         C1 = DLAMC3( B1*BASE, ZERO )
+         D1 = ZERO
+         DO 20 I = 1, BASE
+            D1 = D1 + B1
+   20    CONTINUE
+         B2 = DLAMC3( A*RBASE, ZERO )
+         C2 = DLAMC3( B2 / RBASE, ZERO )
+         D2 = ZERO
+         DO 30 I = 1, BASE
+            D2 = D2 + B2
+   30    CONTINUE
+         GO TO 10
+      END IF
+*+    END WHILE
+*
+      RETURN
+*
+*     End of DLAMC4
+*
+      END
+*
+************************************************************************
+*
+      SUBROUTINE DLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     October 31, 1992
+*
+*     .. Scalar Arguments ..
+      LOGICAL            IEEE
+      INTEGER            BETA, EMAX, EMIN, P
+      DOUBLE PRECISION   RMAX
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  DLAMC5 attempts to compute RMAX, the largest machine floating-point
+*  number, without overflow.  It assumes that EMAX + abs(EMIN) sum
+*  approximately to a power of 2.  It will fail on machines where this
+*  assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+*  EMAX = 28718).  It will also fail if the value supplied for EMIN is
+*  too large (i.e. too close to zero), probably with overflow.
+*
+*  Arguments
+*  =========
+*
+*  BETA    (input) INTEGER
+*          The base of floating-point arithmetic.
+*
+*  P       (input) INTEGER
+*          The number of base BETA digits in the mantissa of a
+*          floating-point value.
+*
+*  EMIN    (input) INTEGER
+*          The minimum exponent before (gradual) underflow.
+*
+*  IEEE    (input) LOGICAL
+*          A logical flag specifying whether or not the arithmetic
+*          system is thought to comply with the IEEE standard.
+*
+*  EMAX    (output) INTEGER
+*          The largest exponent before overflow
+*
+*  RMAX    (output) DOUBLE PRECISION
+*          The largest machine floating-point number.
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
+      DOUBLE PRECISION   OLDY, RECBAS, Y, Z
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMC3
+      EXTERNAL           DLAMC3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     First compute LEXP and UEXP, two powers of 2 that bound
+*     abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
+*     approximately to the bound that is closest to abs(EMIN).
+*     (EMAX is the exponent of the required number RMAX).
+*
+      LEXP = 1
+      EXBITS = 1
+   10 CONTINUE
+      TRY = LEXP*2
+      IF( TRY.LE.( -EMIN ) ) THEN
+         LEXP = TRY
+         EXBITS = EXBITS + 1
+         GO TO 10
+      END IF
+      IF( LEXP.EQ.-EMIN ) THEN
+         UEXP = LEXP
+      ELSE
+         UEXP = TRY
+         EXBITS = EXBITS + 1
+      END IF
+*
+*     Now -LEXP is less than or equal to EMIN, and -UEXP is greater
+*     than or equal to EMIN. EXBITS is the number of bits needed to
+*     store the exponent.
+*
+      IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
+         EXPSUM = 2*LEXP
+      ELSE
+         EXPSUM = 2*UEXP
+      END IF
+*
+*     EXPSUM is the exponent range, approximately equal to
+*     EMAX - EMIN + 1 .
+*
+      EMAX = EXPSUM + EMIN - 1
+      NBITS = 1 + EXBITS + P
+*
+*     NBITS is the total number of bits needed to store a
+*     floating-point number.
+*
+      IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
+*
+*        Either there are an odd number of bits used to store a
+*        floating-point number, which is unlikely, or some bits are
+*        not used in the representation of numbers, which is possible,
+*        (e.g. Cray machines) or the mantissa has an implicit bit,
+*        (e.g. IEEE machines, Dec Vax machines), which is perhaps the
+*        most likely. We have to assume the last alternative.
+*        If this is true, then we need to reduce EMAX by one because
+*        there must be some way of representing zero in an implicit-bit
+*        system. On machines like Cray, we are reducing EMAX by one
+*        unnecessarily.
+*
+         EMAX = EMAX - 1
+      END IF
+*
+      IF( IEEE ) THEN
+*
+*        Assume we are on an IEEE machine which reserves one exponent
+*        for infinity and NaN.
+*
+         EMAX = EMAX - 1
+      END IF
+*
+*     Now create RMAX, the largest machine number, which should
+*     be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
+*
+*     First compute 1.0 - BETA**(-P), being careful that the
+*     result is less than 1.0 .
+*
+      RECBAS = ONE / BETA
+      Z = BETA - ONE
+      Y = ZERO
+      DO 20 I = 1, P
+         Z = Z*RECBAS
+         IF( Y.LT.ONE )
+     $      OLDY = Y
+         Y = DLAMC3( Y, Z )
+   20 CONTINUE
+      IF( Y.GE.ONE )
+     $   Y = OLDY
+*
+*     Now multiply by BETA**EMAX to get RMAX.
+*
+      DO 30 I = 1, EMAX
+         Y = DLAMC3( Y*BETA, ZERO )
+   30 CONTINUE
+*
+      RMAX = Y
+      RETURN
+*
+*     End of DLAMC5
+*
+      END
diff --git a/libcruft/lapack/dlange.f b/libcruft/lapack/dlange.f
--- a/libcruft/lapack/dlange.f
+++ b/libcruft/lapack/dlange.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlanhs.f b/libcruft/lapack/dlanhs.f
--- a/libcruft/lapack/dlanhs.f
+++ b/libcruft/lapack/dlanhs.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlanst.f b/libcruft/lapack/dlanst.f
--- a/libcruft/lapack/dlanst.f
+++ b/libcruft/lapack/dlanst.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlansy.f b/libcruft/lapack/dlansy.f
--- a/libcruft/lapack/dlansy.f
+++ b/libcruft/lapack/dlansy.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlanv2.f b/libcruft/lapack/dlanv2.f
--- a/libcruft/lapack/dlanv2.f
+++ b/libcruft/lapack/dlanv2.f
@@ -1,9 +1,9 @@
       SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994 
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION   A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
@@ -39,38 +39,45 @@
 *  RT2R    (output) DOUBLE PRECISION
 *  RT2I    (output) DOUBLE PRECISION
 *          The real and imaginary parts of the eigenvalues. If the
-*          eigenvalues are both real, abs(RT1R) >= abs(RT2R); if the
 *          eigenvalues are a complex conjugate pair, RT1I > 0.
 *
 *  CS      (output) DOUBLE PRECISION
 *  SN      (output) DOUBLE PRECISION
 *          Parameters of the rotation matrix.
 *
+*  Further Details
+*  ===============
+*
+*  Modified by V. Sima, Research Institute for Informatics, Bucharest,
+*  Romania, to reduce the risk of cancellation errors,
+*  when computing real eigenvalues, and to ensure, if possible, that
+*  abs(RT1R) >= abs(RT2R).
+*
 *  =====================================================================
 *
 *     .. Parameters ..
       DOUBLE PRECISION   ZERO, HALF, ONE
       PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   MULTPL
+      PARAMETER          ( MULTPL = 4.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      DOUBLE PRECISION   AA, BB, CC, CS1, DD, P, SAB, SAC, SIGMA, SN1,
-     $                   TAU, TEMP
+      DOUBLE PRECISION   AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
+     $                   SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
 *     ..
 *     .. External Functions ..
-      DOUBLE PRECISION   DLAPY2
-      EXTERNAL           DLAPY2
+      DOUBLE PRECISION   DLAMCH, DLAPY2
+      EXTERNAL           DLAMCH, DLAPY2
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, SIGN, SQRT
+      INTRINSIC          ABS, MAX, MIN, SIGN, SQRT
 *     ..
 *     .. Executable Statements ..
 *
-*     Initialize CS and SN
-*
-      CS = ONE
-      SN = ZERO
-*
+      EPS = DLAMCH( 'P' )
       IF( C.EQ.ZERO ) THEN
+         CS = ONE
+         SN = ZERO
          GO TO 10
 *
       ELSE IF( B.EQ.ZERO ) THEN
@@ -85,74 +92,98 @@
          B = -C
          C = ZERO
          GO TO 10
-      ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE.
-     $   SIGN( ONE, C ) ) THEN
+      ELSE IF( ( A-D ).EQ.ZERO .AND. SIGN( ONE, B ).NE.SIGN( ONE, C ) )
+     $          THEN
+         CS = ONE
+         SN = ZERO
          GO TO 10
       ELSE
 *
-*        Make diagonal elements equal
-*
          TEMP = A - D
          P = HALF*TEMP
-         SIGMA = B + C
-         TAU = DLAPY2( SIGMA, TEMP )
-         CS1 = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
-         SN1 = -( P / ( TAU*CS1 ) )*SIGN( ONE, SIGMA )
+         BCMAX = MAX( ABS( B ), ABS( C ) )
+         BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C )
+         SCALE = MAX( ABS( P ), BCMAX )
+         Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS
+*
+*        If Z is of the order of the machine accuracy, postpone the
+*        decision on the nature of eigenvalues
 *
-*        Compute [ AA  BB ] = [ A  B ] [ CS1 -SN1 ]
-*                [ CC  DD ]   [ C  D ] [ SN1  CS1 ]
+         IF( Z.GE.MULTPL*EPS ) THEN
+*
+*           Real eigenvalues. Compute A and D.
 *
-         AA = A*CS1 + B*SN1
-         BB = -A*SN1 + B*CS1
-         CC = C*CS1 + D*SN1
-         DD = -C*SN1 + D*CS1
+            Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P )
+            A = D + Z
+            D = D - ( BCMAX / Z )*BCMIS
+*
+*           Compute B and the rotation matrix
 *
-*        Compute [ A  B ] = [ CS1  SN1 ] [ AA  BB ]
-*                [ C  D ]   [-SN1  CS1 ] [ CC  DD ]
+            TAU = DLAPY2( C, Z )
+            CS = Z / TAU
+            SN = C / TAU
+            B = B - C
+            C = ZERO
+         ELSE
 *
-         A = AA*CS1 + CC*SN1
-         B = BB*CS1 + DD*SN1
-         C = -AA*SN1 + CC*CS1
-         D = -BB*SN1 + DD*CS1
+*           Complex eigenvalues, or real (almost) equal eigenvalues.
+*           Make diagonal elements equal.
 *
-*        Accumulate transformation
+            SIGMA = B + C
+            TAU = DLAPY2( SIGMA, TEMP )
+            CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
+            SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )
 *
-         TEMP = CS*CS1 - SN*SN1
-         SN = CS*SN1 + SN*CS1
-         CS = TEMP
+*           Compute [ AA  BB ] = [ A  B ] [ CS -SN ]
+*                   [ CC  DD ]   [ C  D ] [ SN  CS ]
 *
-         TEMP = HALF*( A+D )
-         A = TEMP
-         D = TEMP
+            AA = A*CS + B*SN
+            BB = -A*SN + B*CS
+            CC = C*CS + D*SN
+            DD = -C*SN + D*CS
+*
+*           Compute [ A  B ] = [ CS  SN ] [ AA  BB ]
+*                   [ C  D ]   [-SN  CS ] [ CC  DD ]
 *
-         IF( C.NE.ZERO ) THEN
-            IF( B.NE.ZERO ) THEN
-               IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
+            A = AA*CS + CC*SN
+            B = BB*CS + DD*SN
+            C = -AA*SN + CC*CS
+            D = -BB*SN + DD*CS
 *
-*                 Real eigenvalues: reduce to upper triangular form
+            TEMP = HALF*( A+D )
+            A = TEMP
+            D = TEMP
+*
+            IF( C.NE.ZERO ) THEN
+               IF( B.NE.ZERO ) THEN
+                  IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
 *
-                  SAB = SQRT( ABS( B ) )
-                  SAC = SQRT( ABS( C ) )
-                  P = SIGN( SAB*SAC, C )
-                  TAU = ONE / SQRT( ABS( B+C ) )
-                  A = TEMP + P
-                  D = TEMP - P
-                  B = B - C
+*                    Real eigenvalues: reduce to upper triangular form
+*
+                     SAB = SQRT( ABS( B ) )
+                     SAC = SQRT( ABS( C ) )
+                     P = SIGN( SAB*SAC, C )
+                     TAU = ONE / SQRT( ABS( B+C ) )
+                     A = TEMP + P
+                     D = TEMP - P
+                     B = B - C
+                     C = ZERO
+                     CS1 = SAB*TAU
+                     SN1 = SAC*TAU
+                     TEMP = CS*CS1 - SN*SN1
+                     SN = CS*SN1 + SN*CS1
+                     CS = TEMP
+                  END IF
+               ELSE
+                  B = -C
                   C = ZERO
-                  CS1 = SAB*TAU
-                  SN1 = SAC*TAU
-                  TEMP = CS*CS1 - SN*SN1
-                  SN = CS*SN1 + SN*CS1
-                  CS = TEMP
+                  TEMP = CS
+                  CS = -SN
+                  SN = TEMP
                END IF
-            ELSE
-               B = -C
-               C = ZERO
-               TEMP = CS
-               CS = -SN
-               SN = TEMP
             END IF
          END IF
+*
       END IF
 *
    10 CONTINUE
diff --git a/libcruft/lapack/dlapy2.f b/libcruft/lapack/dlapy2.f
--- a/libcruft/lapack/dlapy2.f
+++ b/libcruft/lapack/dlapy2.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlapy3.f b/libcruft/lapack/dlapy3.f
--- a/libcruft/lapack/dlapy3.f
+++ b/libcruft/lapack/dlapy3.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlarf.f b/libcruft/lapack/dlarf.f
--- a/libcruft/lapack/dlarf.f
+++ b/libcruft/lapack/dlarf.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlarfb.f b/libcruft/lapack/dlarfb.f
--- a/libcruft/lapack/dlarfb.f
+++ b/libcruft/lapack/dlarfb.f
@@ -1,7 +1,7 @@
       SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
      $                   T, LDT, C, LDC, WORK, LDWORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlarfg.f b/libcruft/lapack/dlarfg.f
--- a/libcruft/lapack/dlarfg.f
+++ b/libcruft/lapack/dlarfg.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dlarft.f b/libcruft/lapack/dlarft.f
--- a/libcruft/lapack/dlarft.f
+++ b/libcruft/lapack/dlarft.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlarfx.f b/libcruft/lapack/dlarfx.f
--- a/libcruft/lapack/dlarfx.f
+++ b/libcruft/lapack/dlarfx.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlartg.f b/libcruft/lapack/dlartg.f
--- a/libcruft/lapack/dlartg.f
+++ b/libcruft/lapack/dlartg.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLARTG( F, G, CS, SN, R )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dlas2.f b/libcruft/lapack/dlas2.f
--- a/libcruft/lapack/dlas2.f
+++ b/libcruft/lapack/dlas2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dlascl.f b/libcruft/lapack/dlascl.f
--- a/libcruft/lapack/dlascl.f
+++ b/libcruft/lapack/dlascl.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dlaset.f b/libcruft/lapack/dlaset.f
--- a/libcruft/lapack/dlaset.f
+++ b/libcruft/lapack/dlaset.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlasq1.f b/libcruft/lapack/dlasq1.f
--- a/libcruft/lapack/dlasq1.f
+++ b/libcruft/lapack/dlasq1.f
@@ -1,9 +1,9 @@
       SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, N
@@ -12,81 +12,78 @@
       DOUBLE PRECISION   D( * ), E( * ), WORK( * )
 *     ..
 *
-*     Purpose
-*     =======
+*  Purpose
+*  =======
 *
-*     DLASQ1 computes the singular values of a real N-by-N bidiagonal
-*     matrix with diagonal D and off-diagonal E. The singular values are
-*     computed to high relative accuracy, barring over/underflow or
-*     denormalization. The algorithm is described in
+*  DLASQ1 computes the singular values of a real N-by-N bidiagonal
+*  matrix with diagonal D and off-diagonal E. The singular values
+*  are computed to high relative accuracy, in the absence of
+*  denormalization, underflow and overflow. The algorithm was first
+*  presented in
 *
-*     "Accurate singular values and differential qd algorithms," by
-*     K. V. Fernando and B. N. Parlett,
-*     Numer. Math., Vol-67, No. 2, pp. 191-230,1994.
+*  "Accurate singular values and differential qd algorithms" by K. V.
+*  Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
+*  1994,
+*
+*  and the present implementation is described in "An implementation of
+*  dqds", LAPACK technical report.
 *
-*     See also
-*     "Implementation of differential qd algorithms," by
-*     K. V. Fernando and B. N. Parlett, Technical Report,
-*     Department of Mathematics, University of California at Berkeley,
-*     1994 (Under preparation).
+*  Note : DLASQ1 works only on machines which follow ieee-754
+*  floating-point standard in their handling of infinities and NaNs.
+*  Normal execution of DLASQ1 may create NaNs and infinities and hence
+*  may abort due to a floating point exception in environments which
+*  do not conform to the ieee standard.
 *
-*     Arguments
-*     =========
+*  Arguments
+*  =========
 *
-*  N       (input) INTEGER
-*          The number of rows and columns in the matrix. N >= 0.
+*  N     (input) INTEGER
+*        The number of rows and columns in the matrix. N >= 0.
 *
-*  D       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, D contains the diagonal elements of the
-*          bidiagonal matrix whose SVD is desired. On normal exit,
-*          D contains the singular values in decreasing order.
+*  D     (input/output) DOUBLE PRECISION array, dimension (N)
+*        On entry, D contains the diagonal elements of the
+*        bidiagonal matrix whose SVD is desired. On normal exit,
+*        D contains the singular values in decreasing order.
 *
-*  E       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, elements E(1:N-1) contain the off-diagonal elements
-*          of the bidiagonal matrix whose SVD is desired.
-*          On exit, E is overwritten.
+*  E     (input/output) DOUBLE PRECISION array, dimension (N)
+*        On entry, elements E(1:N-1) contain the off-diagonal elements
+*        of the bidiagonal matrix whose SVD is desired.
+*        On exit, E is overwritten.
+*
+*  WORK  (workspace) DOUBLE PRECISION array, dimension (2*N)
 *
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, the algorithm did not converge;  i
-*                specifies how many superdiagonals did not converge.
+*  INFO  (output) INTEGER
+*        = 0:  successful exit
+*        < 0:  if INFO = -i, the i-th argument had an illegal value
+*        > 0: the algorithm failed
+*              = 1, a split was marked by a positive value in E
+*              = 2, current block of Z not diagonalized after 30*N
+*                   iterations (in inner while loop)
+*              = 3, termination criterion of outer while loop not met
+*                   (program created more than N unreduced blocks)
 *
 *  =====================================================================
 *
 *     .. Parameters ..
-      DOUBLE PRECISION   MEIGTH
-      PARAMETER          ( MEIGTH = -0.125D0 )
       DOUBLE PRECISION   ZERO
       PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   TEN
-      PARAMETER          ( TEN = 10.0D0 )
-      DOUBLE PRECISION   HUNDRD
-      PARAMETER          ( HUNDRD = 100.0D0 )
-      DOUBLE PRECISION   TWO56
-      PARAMETER          ( TWO56 = 256.0D0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            RESTRT
-      INTEGER            I, IERR, J, KE, KEND, M, NY
-      DOUBLE PRECISION   DM, DX, EPS, SCL, SFMIN, SIG1, SIG2, SIGMN,
-     $                   SIGMX, SMALL2, THRESH, TOL, TOL2, TOLMUL
+      INTEGER            I, IINFO
+      DOUBLE PRECISION   EPS, SCALE, SFMIN, SIGMN, SIGMX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DLAS2, DLASCL, DLASQ2, DLASRT, XERBLA
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   DLAMCH
       EXTERNAL           DLAMCH
 *     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DLAS2, DLASCL, DLASQ2, DLASRT, XERBLA
-*     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
+      INTRINSIC          ABS, MAX, SQRT
 *     ..
 *     .. Executable Statements ..
+*
       INFO = 0
       IF( N.LT.0 ) THEN
          INFO = -2
@@ -104,117 +101,54 @@
          RETURN
       END IF
 *
-*     Estimate the largest singular value
+*     Estimate the largest singular value.
 *
       SIGMX = ZERO
       DO 10 I = 1, N - 1
+         D( I ) = ABS( D( I ) )
          SIGMX = MAX( SIGMX, ABS( E( I ) ) )
    10 CONTINUE
+      D( N ) = ABS( D( N ) )
 *
-*     Early return if sigmx is zero (matrix is already diagonal)
+*     Early return if SIGMX is zero (matrix is already diagonal).
 *
-      IF( SIGMX.EQ.ZERO )
-     $   GO TO 70
+      IF( SIGMX.EQ.ZERO ) THEN
+         CALL DLASRT( 'D', N, D, IINFO )
+         GO TO 50
+      END IF
 *
       DO 20 I = 1, N
-         D( I ) = ABS( D( I ) )
          SIGMX = MAX( SIGMX, D( I ) )
    20 CONTINUE
 *
-*     Get machine parameters
-*
-      EPS = DLAMCH( 'EPSILON' )
-      SFMIN = DLAMCH( 'SAFE MINIMUM' )
-*
-*     Compute singular values to relative accuracy TOL
-*     It is assumed that tol**2 does not underflow.
-*
-      TOLMUL = MAX( TEN, MIN( HUNDRD, EPS**( -MEIGTH ) ) )
-      TOL = TOLMUL*EPS
-      TOL2 = TOL**2
-*
-      THRESH = SIGMX*SQRT( SFMIN )*TOL
+*     Copy D and E into WORK (in the Z format) and scale (squaring the
+*     input data makes scaling by a power of the radix pointless).
 *
-*     Scale matrix so the square of the largest element is
-*     1 / ( 256 * SFMIN )
+      EPS = DLAMCH( 'Precision' )
+      SFMIN = DLAMCH( 'Safe minimum' )
+      SCALE = SQRT( EPS / SFMIN )
+      CALL DCOPY( N, D, 1, WORK( 1 ), 2 )
+      CALL DCOPY( N-1, E, 1, WORK( 2 ), 2 )
+      CALL DLASCL( 'G', 0, 0, SIGMX, SCALE, 2*N-1, 1, WORK, 2*N-1,
+     $             IINFO )
 *
-      SCL = SQRT( ONE / ( TWO56*SFMIN ) )
-      SMALL2 = ONE / ( TWO56*TOLMUL**2 )
-      CALL DCOPY( N, D, 1, WORK( 1 ), 1 )
-      CALL DCOPY( N-1, E, 1, WORK( N+1 ), 1 )
-      CALL DLASCL( 'G', 0, 0, SIGMX, SCL, N, 1, WORK( 1 ), N, IERR )
-      CALL DLASCL( 'G', 0, 0, SIGMX, SCL, N-1, 1, WORK( N+1 ), N-1,
-     $             IERR )
-*
-*     Square D and E (the input for the qd algorithm)
-*
-      DO 30 J = 1, 2*N - 1
-         WORK( J ) = WORK( J )**2
-   30 CONTINUE
-*
-*     Apply qd algorithm
+*     Compute the q's and e's.
 *
-      M = 0
-      E( N ) = ZERO
-      DX = WORK( 1 )
-      DM = DX
-      KE = 0
-      RESTRT = .FALSE.
-      DO 60 I = 1, N
-         IF( ABS( E( I ) ).LE.THRESH .OR. WORK( N+I ).LE.TOL2*
-     $       ( DM / DBLE( I-M ) ) ) THEN
-            NY = I - M
-            IF( NY.EQ.1 ) THEN
-               GO TO 50
-            ELSE IF( NY.EQ.2 ) THEN
-               CALL DLAS2( D( M+1 ), E( M+1 ), D( M+2 ), SIG1, SIG2 )
-               D( M+1 ) = SIG1
-               D( M+2 ) = SIG2
-            ELSE
-               KEND = KE + 1 - M
-               CALL DLASQ2( NY, D( M+1 ), E( M+1 ), WORK( M+1 ),
-     $                      WORK( M+N+1 ), EPS, TOL2, SMALL2, DM, KEND,
-     $                      INFO )
+      DO 30 I = 1, 2*N - 1
+         WORK( I ) = WORK( I )**2
+   30 CONTINUE
+      WORK( 2*N ) = ZERO
 *
-*                 Return, INFO = number of unconverged superdiagonals
-*
-               IF( INFO.NE.0 ) THEN
-                  INFO = INFO + I
-                  RETURN
-               END IF
-*
-*                 Undo scaling
+      CALL DLASQ2( N, WORK, INFO )
 *
-               DO 40 J = M + 1, M + NY
-                  D( J ) = SQRT( D( J ) )
-   40          CONTINUE
-               CALL DLASCL( 'G', 0, 0, SCL, SIGMX, NY, 1, D( M+1 ), NY,
-     $                      IERR )
-            END IF
-   50       CONTINUE
-            M = I
-            IF( I.NE.N ) THEN
-               DX = WORK( I+1 )
-               DM = DX
-               KE = I
-               RESTRT = .TRUE.
-            END IF
-         END IF
-         IF( I.NE.N .AND. .NOT.RESTRT ) THEN
-            DX = WORK( I+1 )*( DX / ( DX+WORK( N+I ) ) )
-            IF( DM.GT.DX ) THEN
-               DM = DX
-               KE = I
-            END IF
-         END IF
-         RESTRT = .FALSE.
-   60 CONTINUE
-      KEND = KE + 1
+      IF( INFO.EQ.0 ) THEN
+         DO 40 I = 1, N
+            D( I ) = SQRT( WORK( I ) )
+   40    CONTINUE
+         CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
+      END IF
 *
-*     Sort the singular values into decreasing order
-*
-   70 CONTINUE
-      CALL DLASRT( 'D', N, D, INFO )
+   50 CONTINUE
       RETURN
 *
 *     End of DLASQ1
diff --git a/libcruft/lapack/dlasq2.f b/libcruft/lapack/dlasq2.f
--- a/libcruft/lapack/dlasq2.f
+++ b/libcruft/lapack/dlasq2.f
@@ -1,267 +1,424 @@
-      SUBROUTINE DLASQ2( M, Q, E, QQ, EE, EPS, TOL2, SMALL2, SUP, KEND,
-     $                   INFO )
+      SUBROUTINE DLASQ2( N, Z, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
-      INTEGER            INFO, KEND, M
-      DOUBLE PRECISION   EPS, SMALL2, SUP, TOL2
+      INTEGER            INFO, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   E( * ), EE( * ), Q( * ), QQ( * )
+      DOUBLE PRECISION   Z( * )
 *     ..
 *
-*     Purpose
-*     =======
+*  Purpose
+*  =======
 *
-*     DLASQ2 computes the singular values of a real N-by-N unreduced
-*     bidiagonal matrix with squared diagonal elements in Q and
-*     squared off-diagonal elements in E. The singular values are
-*     computed to relative accuracy TOL, barring over/underflow or
-*     denormalization.
-*
-*     Arguments
-*     =========
+*  DLASQ2 computes all the eigenvalues of the symmetric positive
+*  definite tridiagonal matrix associated with the qd array Z to high
+*  relative accuracy are computed to high relative accuracy, in the
+*  absence of denormalization, underflow and overflow.
 *
-*  M       (input) INTEGER
-*          The number of rows and columns in the matrix. M >= 0.
-*
-*  Q       (output) DOUBLE PRECISION array, dimension (M)
-*          On normal exit, contains the squared singular values.
+*  To see the relation of Z to the tridiagonal matrix, let L be a
+*  unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
+*  let U be an upper bidiagonal matrix with 1's above and diagonal
+*  Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
+*  symmetric tridiagonal to which it is similar.
 *
-*  E       (workspace) DOUBLE PRECISION array, dimension (M)
+*  Note : DLASQ2 works only on machines which follow ieee-754
+*  floating-point standard in their handling of infinities and NaNs.
+*  Normal execution of DLASQ2 may create NaNs and infinities and hence
+*  may abort due to a floating point exception in environments which
+*  do not conform to the ieee standard.
 *
-*  QQ      (input/output) DOUBLE PRECISION array, dimension (M)
-*          On entry, QQ contains the squared diagonal elements of the
-*          bidiagonal matrix whose SVD is desired.
-*          On exit, QQ is overwritten.
+*  Arguments
+*  =========
+*
+*  N     (input) INTEGER
+*        The number of rows and columns in the matrix. N >= 0.
 *
-*  EE      (input/output) DOUBLE PRECISION array, dimension (M)
-*          On entry, EE(1:N-1) contains the squared off-diagonal
-*          elements of the bidiagonal matrix whose SVD is desired.
-*          On exit, EE is overwritten.
-*
-*  EPS     (input) DOUBLE PRECISION
-*          Machine epsilon.
-*
-*  TOL2    (input) DOUBLE PRECISION
-*          Desired relative accuracy of computed eigenvalues
-*          as defined in DLASQ1.
+*  Z     (workspace) DOUBLE PRECISION array, dimension ( 4*N )
+*        On entry Z holds the qd array. On exit, entries 1 to N hold
+*        the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
+*        trace, Z( 2*N+2 ) holds the sum of the eigenvalues, Z( 2*N+3 )
+*        holds the iteration count, Z( 2*N+4 ) holds NDIVS/NIN^2, and
+*        Z( 2*N+5 ) holds the percentage of shifts that failed.
 *
-*  SMALL2  (input) DOUBLE PRECISION
-*          A threshold value as defined in DLASQ1.
-*
-*  SUP     (input/output) DOUBLE PRECISION
-*          Upper bound for the smallest eigenvalue.
+*  INFO  (output) INTEGER
+*        = 0: successful exit
+*        < 0: if the i-th argument is a scalar and had an illegal
+*             value, then INFO = -i, if the i-th argument is an
+*             array and the j-entry had an illegal value, then
+*             INFO = -(i*100+j)
+*        > 0: the algorithm failed
+*              = 1, a split was marked by a positive value in E
+*              = 2, current block of Z not diagonalized after 30*N
+*                   iterations (in inner while loop)
+*              = 3, termination criterion of outer while loop not met
+*                   (program created more than N unreduced blocks)
 *
-*  KEND    (input/output) INTEGER
-*          Index where minimum d occurs.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, the algorithm did not converge;  i
-*                specifies how many superdiagonals did not converge.
+*  Further Details
+*  ===============
+*  Local Variables: I0:N0 defines a current unreduced segment of Z.
+*  The shifts are accumulated in SIGMA. Iteration count is in ITER.
+*  Ping-pong is controlled by PP (alternates between 0 and 1).
 *
 *  =====================================================================
 *
 *     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-      DOUBLE PRECISION   FOUR, HALF
-      PARAMETER          ( FOUR = 4.0D+0, HALF = 0.5D+0 )
+      DOUBLE PRECISION   CBIAS
+      PARAMETER          ( CBIAS = 1.50D0 )
+      DOUBLE PRECISION   ZERO, HALF, ONE, TWO, FOUR, TEN, HNDRD
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0,
+     $                   TWO = 2.0D0, FOUR = 4.0D0, TEN = 10.0D0,
+     $                   HNDRD = 100.0D0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            ICONV, IPHASE, ISP, N, OFF, OFF1
-      DOUBLE PRECISION   QEMAX, SIGMA, XINF, XX, YY
+      INTEGER            I0, I4, IINFO, IPN4, ITER, IWHILA, IWHILB, K,
+     $                   N0, NBIG, NDIV, NFAIL, PP, SPLT
+      DOUBLE PRECISION   D, DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, E,
+     $                   EMAX, EMIN, EPS, EPS2, OLDEMN, QMAX, QMIN, S,
+     $                   SIGMA, T, TAU, TEMP, TRACE, ZMAX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLASQ3
+      EXTERNAL           DLASQ3, DLASQ5, DLASRT, XERBLA
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           DLAMCH
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, NINT, SQRT
+      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
 *     ..
 *     .. Executable Statements ..
-      N = M
+*
+*     Test the input arguments.
+*     (in case DLASQ2 is not called by DLASQ1)
 *
-*     Set the default maximum number of iterations
+      INFO = 0
+      EPS = DLAMCH( 'Precision' )*TEN
+      EPS2 = EPS**2
 *
-      OFF = 0
-      OFF1 = OFF + 1
-      SIGMA = ZERO
-      XINF = ZERO
-      ICONV = 0
-      IPHASE = 2
+      IF( N.LT.0 ) THEN
+         INFO = -1
+         CALL XERBLA( 'DLASQ2', 1 )
+         RETURN
+      ELSE IF( N.EQ.0 ) THEN
+         RETURN
+      ELSE IF( N.EQ.1 ) THEN
 *
-*     Try deflation at the bottom
+*        1-by-1 case.
+*
+         IF( Z( 1 ).LT.ZERO ) THEN
+            INFO = -201
+            CALL XERBLA( 'DLASQ2', 2 )
+         END IF
+         RETURN
+      ELSE IF( N.EQ.2 ) THEN
+*
+*        2-by-2 case.
 *
-*     1x1 deflation
-*
-   10 CONTINUE
-      IF( N.LE.2 )
-     $   GO TO 20
-      IF( EE( N-1 ).LE.MAX( QQ( N ), XINF, SMALL2 )*TOL2 ) THEN
-         Q( N ) = QQ( N )
-         N = N - 1
-         IF( KEND.GT.N )
-     $      KEND = N
-         SUP = MIN( QQ( N ), QQ( N-1 ) )
-         GO TO 10
+         IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN
+            INFO = -2
+            CALL XERBLA( 'DLASQ2', 2 )
+            RETURN
+         ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN
+            D = Z( 3 )
+            Z( 3 ) = Z( 1 )
+            Z( 1 ) = D
+         END IF
+         Z( 5 ) = Z( 1 ) + Z( 2 ) + Z( 3 )
+         IF( Z( 2 ).GT.Z( 3 )*EPS2 ) THEN
+            T = HALF*( ( Z( 1 )-Z( 3 ) )+Z( 2 ) )
+            S = Z( 3 )*( Z( 2 ) / T )
+            IF( S.LE.T ) THEN
+               S = Z( 3 )*( Z( 2 ) / ( T*( ONE+SQRT( ONE+S / T ) ) ) )
+            ELSE
+               S = Z( 3 )*( Z( 2 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
+            END IF
+            T = Z( 1 ) + ( S+Z( 2 ) )
+            Z( 3 ) = Z( 3 )*( Z( 1 ) / T )
+            Z( 1 ) = T
+         END IF
+         Z( 2 ) = Z( 3 )
+         Z( 6 ) = Z( 2 ) + Z( 1 )
+         Z( 7 ) = ZERO
+         Z( 8 ) = ZERO
+         Z( 9 ) = ZERO
+         RETURN
       END IF
 *
-*     2x2 deflation
+*     Check for negative data and compute sums of q's and e's.
+*
+      Z( 2*N ) = ZERO
+      EMIN = Z( 2 )
+      QMAX = ZERO
+      D = ZERO
+      E = ZERO
+*
+      DO 10 K = 1, N
+         IF( Z( K ).LT.ZERO ) THEN
+            INFO = -( 200+K )
+            CALL XERBLA( 'DLASQ2', 2 )
+            RETURN
+         ELSE IF( Z( N+K ).LT.ZERO ) THEN
+            INFO = -( 200+N+K )
+            CALL XERBLA( 'DLASQ2', 2 )
+            RETURN
+         END IF
+         D = D + Z( K )
+         E = E + Z( N+K )
+         QMAX = MAX( QMAX, Z( K ) )
+   10 CONTINUE
+      ZMAX = QMAX
+      DO 20 K = 1, N - 1
+         EMIN = MIN( EMIN, Z( N+K ) )
+         ZMAX = MAX( ZMAX, Z( N+K ) )
+   20 CONTINUE
+*
+*     Check for diagonality.
 *
-      IF( EE( N-2 ).LE.MAX( XINF, SMALL2,
-     $    ( QQ( N ) / ( QQ( N )+EE( N-1 )+QQ( N-1 ) ) )*QQ( N-1 ) )*
-     $    TOL2 ) THEN
-         QEMAX = MAX( QQ( N ), QQ( N-1 ), EE( N-1 ) )
-         IF( QEMAX.NE.ZERO ) THEN
-            IF( QEMAX.EQ.QQ( N-1 ) ) THEN
-               XX = HALF*( QQ( N )+QQ( N-1 )+EE( N-1 )+QEMAX*
-     $              SQRT( ( ( QQ( N )-QQ( N-1 )+EE( N-1 ) ) /
-     $              QEMAX )**2+FOUR*EE( N-1 ) / QEMAX ) )
-            ELSE IF( QEMAX.EQ.QQ( N ) ) THEN
-               XX = HALF*( QQ( N )+QQ( N-1 )+EE( N-1 )+QEMAX*
-     $              SQRT( ( ( QQ( N-1 )-QQ( N )+EE( N-1 ) ) /
-     $              QEMAX )**2+FOUR*EE( N-1 ) / QEMAX ) )
-            ELSE
-               XX = HALF*( QQ( N )+QQ( N-1 )+EE( N-1 )+QEMAX*
-     $              SQRT( ( ( QQ( N )-QQ( N-1 )+EE( N-1 ) ) /
-     $              QEMAX )**2+FOUR*QQ( N-1 ) / QEMAX ) )
-            END IF
-            YY = ( MAX( QQ( N ), QQ( N-1 ) ) / XX )*
-     $           MIN( QQ( N ), QQ( N-1 ) )
-         ELSE
-            XX = ZERO
-            YY = ZERO
-         END IF
-         Q( N-1 ) = XX
-         Q( N ) = YY
-         N = N - 2
-         IF( KEND.GT.N )
-     $      KEND = N
-         SUP = QQ( N )
-         GO TO 10
+      IF( E.EQ.ZERO ) THEN
+         CALL DLASRT( 'D', N, Z, IINFO )
+         Z( 2*N-1 ) = D
+         RETURN
+      END IF
+*
+      TRACE = D + E
+      I0 = 1
+      N0 = N
+*
+*     Check for zero data.
+*
+      IF( TRACE.EQ.ZERO ) THEN
+         Z( 2*N-1 ) = ZERO
+         RETURN
+      END IF
+*
+*     Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...).
+*
+      DO 30 K = 2*N, 2, -2
+         Z( 2*K ) = ZERO
+         Z( 2*K-1 ) = Z( K )
+         Z( 2*K-2 ) = ZERO
+         Z( 2*K-3 ) = Z( K-1 )
+   30 CONTINUE
+*
+*     Reverse the qd-array, if warranted.
+*
+      IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN
+         IPN4 = 4*( I0+N0 )
+         DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4
+            TEMP = Z( I4-3 )
+            Z( I4-3 ) = Z( IPN4-I4-3 )
+            Z( IPN4-I4-3 ) = TEMP
+            TEMP = Z( I4-1 )
+            Z( I4-1 ) = Z( IPN4-I4-5 )
+            Z( IPN4-I4-5 ) = TEMP
+   40    CONTINUE
       END IF
 *
-   20 CONTINUE
-      IF( N.EQ.0 ) THEN
+*     Initial split checking via dqd and Li's test.
+*
+      PP = 0
 *
-*         The lower branch is finished
+      DO 80 K = 1, 2
 *
-         IF( OFF.EQ.0 ) THEN
+         IF( EMIN.LE.EPS2*QMAX ) THEN
+*
+*           Li's reverse test.
 *
-*         No upper branch; return to DLASQ1
+            D = Z( 4*N0+PP-3 )
+            DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4
+               IF( Z( I4-1 ).LE.EPS2*D ) THEN
+                  Z( I4-1 ) = -ZERO
+                  D = Z( I4-3 )
+               ELSE
+                  D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) )
+               END IF
+   50       CONTINUE
 *
-            RETURN
-         ELSE
-*
-*         Going back to upper branch
+*           dqd maps Z to ZZ plus Li's test.
 *
-            XINF = ZERO
-            IF( EE( OFF ).GT.ZERO ) THEN
-               ISP = NINT( EE( OFF ) )
-               IPHASE = 1
-            ELSE
-               ISP = -NINT( EE( OFF ) )
-               IPHASE = 2
-            END IF
-            SIGMA = E( OFF )
-            N = OFF - ISP + 1
-            OFF1 = ISP
-            OFF = OFF1 - 1
-            IF( N.LE.2 )
-     $         GO TO 20
-            IF( IPHASE.EQ.1 ) THEN
-               SUP = MIN( Q( N+OFF ), Q( N-1+OFF ), Q( N-2+OFF ) )
-            ELSE
-               SUP = MIN( QQ( N+OFF ), QQ( N-1+OFF ), QQ( N-2+OFF ) )
-            END IF
-            KEND = 0
-            ICONV = -3
+            EMIN = Z( 4*I0+PP+1 )
+            D = Z( 4*I0+PP-3 )
+            DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4
+               IF( Z( I4-1 ).LE.EPS2*D ) THEN
+                  Z( I4-1 ) = -ZERO
+                  Z( I4-2*PP-2 ) = D
+                  Z( I4-2*PP ) = ZERO
+                  D = Z( I4+1 )
+                  EMIN = ZERO
+               ELSE
+                  Z( I4-2*PP-2 ) = D + Z( I4-1 )
+                  Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) /
+     $                           Z( I4-2*PP-2 ) )
+                  D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) )
+                  EMIN = MIN( EMIN, Z( I4-2*PP ) )
+               END IF
+   60       CONTINUE
+            Z( 4*N0-PP-2 ) = D
+         ELSE
+            TAU = ZERO
+            CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
+     $                   DN1, DN2 )
+*
+            EMIN = Z( 4*N0 )
          END IF
-      ELSE IF( N.EQ.1 ) THEN
+*
+*        Now find qmax.
+*
+         QMAX = Z( 4*I0-PP-2 )
+         DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4
+            QMAX = MAX( QMAX, Z( I4 ) )
+   70    CONTINUE
+*
+*        Prepare for the next iteration on K.
+*
+         PP = 1 - PP
+   80 CONTINUE
 *
-*     1x1 Solver
+      ITER = 2
+      NFAIL = 0
+      NDIV = 2*( N0-I0 )
+*
+      DO 140 IWHILA = 1, N + 1
+         IF( N0.LT.1 )
+     $      GO TO 150
 *
-         IF( IPHASE.EQ.1 ) THEN
-            Q( OFF1 ) = Q( OFF1 ) + SIGMA
+*        While array unfinished do
+*
+*        E(N0) holds the value of SIGMA when submatrix in I0:N0
+*        splits from the rest of the array, but is negated.
+*
+         DESIG = ZERO
+         IF( N0.EQ.N ) THEN
+            SIGMA = ZERO
          ELSE
-            Q( OFF1 ) = QQ( OFF1 ) + SIGMA
+            SIGMA = -Z( 4*N0-1 )
          END IF
-         N = 0
-         GO TO 20
+         IF( SIGMA.LT.ZERO ) THEN
+            INFO = 1
+            RETURN
+         END IF
 *
-*     2x2 Solver
+*        Find last unreduced submatrix's top index I0, find QMAX and
+*        EMIN. Find Gershgorin-type bound if Q's much greater than E's.
 *
-      ELSE IF( N.EQ.2 ) THEN
-         IF( IPHASE.EQ.2 ) THEN
-            QEMAX = MAX( QQ( N+OFF ), QQ( N-1+OFF ), EE( N-1+OFF ) )
-            IF( QEMAX.NE.ZERO ) THEN
-               IF( QEMAX.EQ.QQ( N-1+OFF ) ) THEN
-                  XX = HALF*( QQ( N+OFF )+QQ( N-1+OFF )+EE( N-1+OFF )+
-     $                 QEMAX*SQRT( ( ( QQ( N+OFF )-QQ( N-1+OFF )+EE( N-
-     $                 1+OFF ) ) / QEMAX )**2+FOUR*EE( OFF+N-1 ) /
-     $                 QEMAX ) )
-               ELSE IF( QEMAX.EQ.QQ( N+OFF ) ) THEN
-                  XX = HALF*( QQ( N+OFF )+QQ( N-1+OFF )+EE( N-1+OFF )+
-     $                 QEMAX*SQRT( ( ( QQ( N-1+OFF )-QQ( N+OFF )+EE( N-
-     $                 1+OFF ) ) / QEMAX )**2+FOUR*EE( N-1+OFF ) /
-     $                 QEMAX ) )
-               ELSE
-                  XX = HALF*( QQ( N+OFF )+QQ( N-1+OFF )+EE( N-1+OFF )+
-     $                 QEMAX*SQRT( ( ( QQ( N+OFF )-QQ( N-1+OFF )+EE( N-
-     $                 1+OFF ) ) / QEMAX )**2+FOUR*QQ( N-1+OFF ) /
-     $                 QEMAX ) )
-               END IF
-               YY = ( MAX( QQ( N+OFF ), QQ( N-1+OFF ) ) / XX )*
-     $              MIN( QQ( N+OFF ), QQ( N-1+OFF ) )
-            ELSE
-               XX = ZERO
-               YY = ZERO
+         EMAX = ZERO
+         EMIN = ABS( Z( 4*N0-5 ) )
+         QMIN = Z( 4*N0-3 )
+         QMAX = QMIN
+         DO 90 I4 = 4*N0, 8, -4
+            IF( Z( I4-5 ).LE.ZERO )
+     $         GO TO 100
+            IF( QMIN.GE.FOUR*EMAX ) THEN
+               QMIN = MIN( QMIN, Z( I4-3 ) )
+               EMAX = MAX( EMAX, Z( I4-5 ) )
             END IF
-         ELSE
-            QEMAX = MAX( Q( N+OFF ), Q( N-1+OFF ), E( N-1+OFF ) )
-            IF( QEMAX.NE.ZERO ) THEN
-               IF( QEMAX.EQ.Q( N-1+OFF ) ) THEN
-                  XX = HALF*( Q( N+OFF )+Q( N-1+OFF )+E( N-1+OFF )+
-     $                 QEMAX*SQRT( ( ( Q( N+OFF )-Q( N-1+OFF )+E( N-1+
-     $                 OFF ) ) / QEMAX )**2+FOUR*E( N-1+OFF ) /
-     $                 QEMAX ) )
-               ELSE IF( QEMAX.EQ.Q( N+OFF ) ) THEN
-                  XX = HALF*( Q( N+OFF )+Q( N-1+OFF )+E( N-1+OFF )+
-     $                 QEMAX*SQRT( ( ( Q( N-1+OFF )-Q( N+OFF )+E( N-1+
-     $                 OFF ) ) / QEMAX )**2+FOUR*E( N-1+OFF ) /
-     $                 QEMAX ) )
-               ELSE
-                  XX = HALF*( Q( N+OFF )+Q( N-1+OFF )+E( N-1+OFF )+
-     $                 QEMAX*SQRT( ( ( Q( N+OFF )-Q( N-1+OFF )+E( N-1+
-     $                 OFF ) ) / QEMAX )**2+FOUR*Q( N-1+OFF ) /
-     $                 QEMAX ) )
+            QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) )
+            EMIN = MIN( EMIN, Z( I4-5 ) )
+   90    CONTINUE
+         I4 = 4
+*
+  100    CONTINUE
+         I0 = I4 / 4
+*
+*        Store EMIN for passing to DLASQ3.
+*
+         Z( 4*N0-1 ) = EMIN
+*
+*        Put -(initial shift) into DMIN.
+*
+         DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) )
+*
+*        Now I0:N0 is unreduced. PP = 0 for ping, PP = 1 for pong.
+*
+         PP = 0
+*
+         NBIG = 30*( N0-I0+1 )
+         DO 120 IWHILB = 1, NBIG
+            IF( I0.GT.N0 )
+     $         GO TO 130
+*
+*           While submatrix unfinished take a good dqds step.
+*
+            CALL DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
+     $                   ITER, NDIV )
+*
+            PP = 1 - PP
+*
+*           When EMIN is very small check for splits.
+*
+            IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN
+               IF( Z( 4*N0 ).LE.EPS2*QMAX .OR. Z( 4*N0-1 ).LE.EPS2*
+     $             SIGMA ) THEN
+                  SPLT = I0 - 1
+                  QMAX = Z( 4*I0-3 )
+                  EMIN = Z( 4*I0-1 )
+                  OLDEMN = Z( 4*I0 )
+                  DO 110 I4 = 4*I0, 4*( N0-3 ), 4
+                     IF( Z( I4 ).LE.EPS2*Z( I4-3 ) .OR. Z( I4-1 ).LE.
+     $                   EPS2*SIGMA ) THEN
+                        Z( I4-1 ) = -SIGMA
+                        SPLT = I4 / 4
+                        QMAX = ZERO
+                        EMIN = Z( I4+3 )
+                        OLDEMN = Z( I4+4 )
+                     ELSE
+                        QMAX = MAX( QMAX, Z( I4+1 ) )
+                        EMIN = MIN( EMIN, Z( I4-1 ) )
+                        OLDEMN = MIN( OLDEMN, Z( I4 ) )
+                     END IF
+  110             CONTINUE
+                  Z( 4*N0-1 ) = EMIN
+                  Z( 4*N0 ) = OLDEMN
+                  I0 = SPLT + 1
                END IF
-               YY = ( MAX( Q( N+OFF ), Q( N-1+OFF ) ) / XX )*
-     $              MIN( Q( N+OFF ), Q( N-1+OFF ) )
-            ELSE
-               XX = ZERO
-               YY = ZERO
             END IF
-         END IF
-         Q( N-1+OFF ) = SIGMA + XX
-         Q( N+OFF ) = YY + SIGMA
-         N = 0
-         GO TO 20
-      END IF
-      CALL DLASQ3( N, Q( OFF1 ), E( OFF1 ), QQ( OFF1 ), EE( OFF1 ), SUP,
-     $             SIGMA, KEND, OFF, IPHASE, ICONV, EPS, TOL2, SMALL2 )
-      IF( SUP.LT.ZERO ) THEN
-         INFO = N + OFF
+*
+  120    CONTINUE
+*
+         INFO = 2
          RETURN
-      END IF
-      OFF1 = OFF + 1
-      GO TO 20
+*
+*        end IWHILB
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+      INFO = 3
+      RETURN
+*
+*     end IWHILA
+*
+  150 CONTINUE
+*
+*     Move q's to the front.
+*
+      DO 160 K = 2, N
+         Z( K ) = Z( 4*K-3 )
+  160 CONTINUE
+*
+*     Sort and compute sum of eigenvalues.
+*
+      CALL DLASRT( 'D', N, Z, IINFO )
+*
+      E = ZERO
+      DO 170 K = N, 1, -1
+         E = E + Z( K )
+  170 CONTINUE
+*
+*     Store trace, sum(eigenvalues) and information on performance.
+*
+      Z( 2*N+1 ) = TRACE
+      Z( 2*N+2 ) = E
+      Z( 2*N+3 ) = DBLE( ITER )
+      Z( 2*N+4 ) = DBLE( NDIV ) / DBLE( N**2 )
+      Z( 2*N+5 ) = HNDRD*NFAIL / DBLE( ITER )
+      RETURN
 *
 *     End of DLASQ2
 *
diff --git a/libcruft/lapack/dlasq3.f b/libcruft/lapack/dlasq3.f
--- a/libcruft/lapack/dlasq3.f
+++ b/libcruft/lapack/dlasq3.f
@@ -1,819 +1,277 @@
-      SUBROUTINE DLASQ3( N, Q, E, QQ, EE, SUP, SIGMA, KEND, OFF, IPHASE,
-     $                   ICONV, EPS, TOL2, SMALL2 )
+      SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
+     $                   ITER, NDIV )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
-      INTEGER            ICONV, IPHASE, KEND, N, OFF
-      DOUBLE PRECISION   EPS, SIGMA, SMALL2, SUP, TOL2
+      INTEGER            I0, ITER, N0, NDIV, NFAIL, PP
+      DOUBLE PRECISION   DESIG, DMIN, QMAX, SIGMA
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   E( * ), EE( * ), Q( * ), QQ( * )
+      DOUBLE PRECISION   Z( * )
 *     ..
 *
-*     Purpose
-*     =======
+*  Purpose
+*  =======
+*  DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+*  In case of failure it changes shifts, and tries again until output
+*  is positive.
 *
-*     DLASQ3 is the workhorse of the whole bidiagonal SVD algorithm.
-*     This can be described as the differential qd with shifts.
-*
-*     Arguments
-*     =========
+*  Arguments
+*  =========
 *
-*  N       (input/output) INTEGER
-*          On entry, N specifies the number of rows and columns
-*          in the matrix. N must be at least 3.
-*          On exit N is non-negative and less than the input value.
+*  I0     (input) INTEGER
+*         First index.
 *
-*  Q       (input/output) DOUBLE PRECISION array, dimension (N)
-*          Q array in ping (see IPHASE below)
+*  N0     (input) INTEGER
+*         Last index.
 *
-*  E       (input/output) DOUBLE PRECISION array, dimension (N)
-*          E array in ping (see IPHASE below)
+*  Z      (input) DOUBLE PRECISION array, dimension ( 4*N )
+*         Z holds the qd array.
 *
-*  QQ      (input/output) DOUBLE PRECISION array, dimension (N)
-*          Q array in pong (see IPHASE below)
-*
-*  EE      (input/output) DOUBLE PRECISION array, dimension (N)
-*          E array in pong (see IPHASE below)
+*  PP     (input) INTEGER
+*         PP=0 for ping, PP=1 for pong.
 *
-*  SUP     (input/output) DOUBLE PRECISION
-*          Upper bound for the smallest eigenvalue
+*  DMIN   (output) DOUBLE PRECISION
+*         Minimum value of d.
 *
-*  SIGMA   (input/output) DOUBLE PRECISION
-*          Accumulated shift for the present submatrix
+*  SIGMA  (output) DOUBLE PRECISION
+*         Sum of shifts used in current segment.
 *
-*  KEND    (input/output) INTEGER
-*          Index where minimum D(i) occurs in recurrence for
-*          splitting criterion
+*  DESIG  (input/output) DOUBLE PRECISION
+*         Lower order part of SIGMA
 *
-*  OFF     (input/output) INTEGER
-*          Offset for arrays
+*  QMAX   (input) DOUBLE PRECISION
+*         Maximum value of q.
 *
-*  IPHASE  (input/output) INTEGER
-*          If IPHASE = 1 (ping) then data is in Q and E arrays
-*          If IPHASE = 2 (pong) then data is in QQ and EE arrays
+*  NFAIL  (output) INTEGER
+*         Number of times shift was too big.
 *
-*  ICONV   (input) INTEGER
-*          If ICONV = 0 a bottom part of a matrix (with a split)
-*          If ICONV =-3 a top part of a matrix (with a split)
+*  ITER   (output) INTEGER
+*         Number of iterations.
 *
-*  EPS     (input) DOUBLE PRECISION
-*          Machine epsilon
+*  NDIV   (output) INTEGER
+*         Number of divisions.
 *
-*  TOL2    (input) DOUBLE PRECISION
-*          Square of the relative tolerance TOL as defined in DLASQ1
-*
-*  SMALL2  (input) DOUBLE PRECISION
-*          A threshold value as defined in DLASQ1
+*  TTYPE  (output) INTEGER
+*         Shift type.
 *
 *  =====================================================================
 *
 *     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-      INTEGER            NPP
-      PARAMETER          ( NPP = 32 )
-      INTEGER            IPP
-      PARAMETER          ( IPP = 5 )
-      DOUBLE PRECISION   HALF, FOUR
-      PARAMETER          ( HALF = 0.5D+0, FOUR = 4.0D+0 )
-      INTEGER            IFLMAX
-      PARAMETER          ( IFLMAX = 2 )
+      DOUBLE PRECISION   CBIAS
+      PARAMETER          ( CBIAS = 1.50D0 )
+      DOUBLE PRECISION   ZERO, QURTR, HALF, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0D0, QURTR = 0.250D0, HALF = 0.5D0,
+     $                   ONE = 1.0D0, TWO = 2.0D0, TEN = 10.0D0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            LDEF, LSPLIT
-      INTEGER            I, IC, ICNT, IFL, IP, ISP, K1END, K2END, KE,
-     $                   KS, MAXIT, N1, N2
-      DOUBLE PRECISION   D, DM, QEMAX, T1, TAU, TOLX, TOLY, TOLZ, XX, YY
+      INTEGER            IPN4, J4, N0IN, NN, TTYPE
+      DOUBLE PRECISION   DMIN1, DMIN2, DN, DN1, DN2, EPS, EPS2, S,
+     $                   SFMIN, T, TAU, TEMP
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DCOPY, DLASQ4
+      EXTERNAL           DLASQ4, DLASQ5, DLASQ6
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           DLAMCH
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, MAX, MIN, SQRT
 *     ..
+*     .. Save statement ..
+      SAVE               TTYPE, DMIN1, DMIN2, DN, DN1, DN2, TAU
+*     ..
+*     .. Data statements ..
+      DATA               TTYPE / 0 /
+      DATA               DMIN1 / ZERO / , DMIN2 / ZERO / , DN / ZERO / ,
+     $                   DN1 / ZERO / , DN2 / ZERO / , TAU / ZERO /
+*     ..
 *     .. Executable Statements ..
-      ICNT = 0
-      TAU = ZERO
-      DM = SUP
-      TOLX = SIGMA*TOL2
-      TOLZ = MAX( SMALL2, SIGMA )*TOL2
 *
-*     Set maximum number of iterations
+      N0IN = N0
+      EPS = DLAMCH( 'Precision' )*TEN
+      SFMIN = DLAMCH( 'Safe minimum' )
+      EPS2 = EPS**2
 *
-      MAXIT = 100*N
+*     Check for deflation.
 *
-*     Flipping
+   10 CONTINUE
 *
-      IC = 2
-      IF( N.GT.3 ) THEN
-         IF( IPHASE.EQ.1 ) THEN
-            DO 10 I = 1, N - 2
-               IF( Q( I ).GT.Q( I+1 ) )
-     $            IC = IC + 1
-               IF( E( I ).GT.E( I+1 ) )
-     $            IC = IC + 1
-   10       CONTINUE
-            IF( Q( N-1 ).GT.Q( N ) )
-     $         IC = IC + 1
-            IF( IC.LT.N ) THEN
-               CALL DCOPY( N, Q, 1, QQ, -1 )
-               CALL DCOPY( N-1, E, 1, EE, -1 )
-               IF( KEND.NE.0 )
-     $            KEND = N - KEND + 1
-               IPHASE = 2
-            END IF
-         ELSE
-            DO 20 I = 1, N - 2
-               IF( QQ( I ).GT.QQ( I+1 ) )
-     $            IC = IC + 1
-               IF( EE( I ).GT.EE( I+1 ) )
-     $            IC = IC + 1
-   20       CONTINUE
-            IF( QQ( N-1 ).GT.QQ( N ) )
-     $         IC = IC + 1
-            IF( IC.LT.N ) THEN
-               CALL DCOPY( N, QQ, 1, Q, -1 )
-               CALL DCOPY( N-1, EE, 1, E, -1 )
-               IF( KEND.NE.0 )
-     $            KEND = N - KEND + 1
-               IPHASE = 1
-            END IF
-         END IF
-      END IF
-      IF( ICONV.EQ.-3 ) THEN
-         IF( IPHASE.EQ.1 ) THEN
-            GO TO 180
-         ELSE
-            GO TO 80
-         END IF
-      END IF
-      IF( IPHASE.EQ.2 )
-     $   GO TO 130
+      IF( N0.LT.I0 )
+     $   RETURN
+      IF( N0.EQ.I0 )
+     $   GO TO 20
+      NN = 4*N0 + PP
+      IF( N0.EQ.( I0+1 ) )
+     $   GO TO 40
+*
+*     Check whether E(N0-1) is negligible, 1-by-1 case.
 *
-*     The ping section of the code
+      IF( Z( NN-5 ).GT.EPS2*( SIGMA+Z( NN-3 ) ) .AND. Z( NN-2*PP-4 ).GT.
+     $    EPS2*Z( NN-7 ) )GO TO 30
+*
+   20 CONTINUE
+*
+      Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
+      N0 = N0 - 1
+      GO TO 10
+*
+*     Check  whether E(N0-2) is negligible, 2-by-2 case.
 *
    30 CONTINUE
-      IFL = 0
-*
-*     Compute the shift
-*
-      IF( KEND.EQ.0 .OR. SUP.EQ.ZERO ) THEN
-         TAU = ZERO
-      ELSE IF( ICNT.GT.0 .AND. DM.LE.TOLZ ) THEN
-         TAU = ZERO
-      ELSE
-         IP = MAX( IPP, N / NPP )
-         N2 = 2*IP + 1
-         IF( N2.GE.N ) THEN
-            N1 = 1
-            N2 = N
-         ELSE IF( KEND+IP.GT.N ) THEN
-            N1 = N - 2*IP
-         ELSE IF( KEND-IP.LT.1 ) THEN
-            N1 = 1
-         ELSE
-            N1 = KEND - IP
-         END IF
-         CALL DLASQ4( N2, Q( N1 ), E( N1 ), TAU, SUP )
-      END IF
-   40 CONTINUE
-      ICNT = ICNT + 1
-      IF( ICNT.GT.MAXIT ) THEN
-         SUP = -ONE
-         RETURN
-      END IF
-      IF( TAU.EQ.ZERO ) THEN
-*
-*     dqd algorithm
 *
-         D = Q( 1 )
-         DM = D
-         KE = 0
-         DO 50 I = 1, N - 3
-            QQ( I ) = D + E( I )
-            D = ( D / QQ( I ) )*Q( I+1 )
-            IF( DM.GT.D ) THEN
-               DM = D
-               KE = I
-            END IF
-   50    CONTINUE
-         KE = KE + 1
-*
-*     Penultimate dqd step (in ping)
+      IF( Z( NN-9 ).GT.EPS2*SIGMA .AND. Z( NN-2*PP-8 ).GT.EPS2*
+     $    Z( NN-11 ) )GO TO 50
 *
-         K2END = KE
-         QQ( N-2 ) = D + E( N-2 )
-         D = ( D / QQ( N-2 ) )*Q( N-1 )
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N - 1
-         END IF
-*
-*     Final dqd step (in ping)
-*
-         K1END = KE
-         QQ( N-1 ) = D + E( N-1 )
-         D = ( D / QQ( N-1 ) )*Q( N )
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N
-         END IF
-         QQ( N ) = D
-      ELSE
+   40 CONTINUE
 *
-*     The dqds algorithm (in ping)
-*
-         D = Q( 1 ) - TAU
-         DM = D
-         KE = 0
-         IF( D.LT.ZERO )
-     $      GO TO 120
-         DO 60 I = 1, N - 3
-            QQ( I ) = D + E( I )
-            D = ( D / QQ( I ) )*Q( I+1 ) - TAU
-            IF( DM.GT.D ) THEN
-               DM = D
-               KE = I
-               IF( D.LT.ZERO )
-     $            GO TO 120
-            END IF
-   60    CONTINUE
-         KE = KE + 1
-*
-*     Penultimate dqds step (in ping)
-*
-         K2END = KE
-         QQ( N-2 ) = D + E( N-2 )
-         D = ( D / QQ( N-2 ) )*Q( N-1 ) - TAU
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N - 1
-            IF( D.LT.ZERO )
-     $         GO TO 120
+      IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
+         S = Z( NN-3 )
+         Z( NN-3 ) = Z( NN-7 )
+         Z( NN-7 ) = S
+      END IF
+      IF( Z( NN-5 ).GT.Z( NN-3 )*EPS2 ) THEN
+         T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
+         S = Z( NN-3 )*( Z( NN-5 ) / T )
+         IF( S.LE.T ) THEN
+            S = Z( NN-3 )*( Z( NN-5 ) / ( T*( ONE+SQRT( ONE+S /
+     $          T ) ) ) )
+         ELSE
+            S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
          END IF
-*
-*     Final dqds step (in ping)
+         T = Z( NN-7 ) + ( S+Z( NN-5 ) )
+         Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
+         Z( NN-7 ) = T
+      END IF
+      Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
+      Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
+      N0 = N0 - 2
+      GO TO 10
 *
-         K1END = KE
-         QQ( N-1 ) = D + E( N-1 )
-         D = ( D / QQ( N-1 ) )*Q( N ) - TAU
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N
-         END IF
-         QQ( N ) = D
-      END IF
-*
-*        Convergence when QQ(N) is small (in ping)
-*
-      IF( ABS( QQ( N ) ).LE.SIGMA*TOL2 ) THEN
-         QQ( N ) = ZERO
-         DM = ZERO
-         KE = N
-      END IF
-      IF( QQ( N ).LT.ZERO )
-     $   GO TO 120
-*
-*     Non-negative qd array: Update the e's
-*
-      DO 70 I = 1, N - 1
-         EE( I ) = ( E( I ) / QQ( I ) )*Q( I+1 )
-   70 CONTINUE
-*
-*     Updating sigma and iphase in ping
-*
-      SIGMA = SIGMA + TAU
-      IPHASE = 2
-   80 CONTINUE
-      TOLX = SIGMA*TOL2
-      TOLY = SIGMA*EPS
-      TOLZ = MAX( SIGMA, SMALL2 )*TOL2
-*
-*     Checking for deflation and convergence (in ping)
+   50 CONTINUE
 *
-   90 CONTINUE
-      IF( N.LE.2 )
-     $   RETURN
-*
-*        Deflation: bottom 1x1 (in ping)
-*
-      LDEF = .FALSE.
-      IF( EE( N-1 ).LE.TOLZ ) THEN
-         LDEF = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         IF( EE( N-1 ).LE.EPS*( SIGMA+QQ( N ) ) ) THEN
-            IF( EE( N-1 )*( QQ( N ) / ( QQ( N )+SIGMA ) ).LE.TOL2*
-     $          ( QQ( N )+SIGMA ) ) THEN
-               LDEF = .TRUE.
-            END IF
-         END IF
-      ELSE
-         IF( EE( N-1 ).LE.QQ( N )*TOL2 ) THEN
-            LDEF = .TRUE.
-         END IF
-      END IF
-      IF( LDEF ) THEN
-         Q( N ) = QQ( N ) + SIGMA
-         N = N - 1
-         ICONV = ICONV + 1
-         GO TO 90
-      END IF
-*
-*        Deflation: bottom 2x2 (in ping)
+*     Reverse the qd-array, if warranted.
 *
-      LDEF = .FALSE.
-      IF( EE( N-2 ).LE.TOLZ ) THEN
-         LDEF = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         T1 = SIGMA + EE( N-1 )*( SIGMA / ( SIGMA+QQ( N ) ) )
-         IF( EE( N-2 )*( T1 / ( QQ( N-1 )+T1 ) ).LE.TOLY ) THEN
-            IF( EE( N-2 )*( QQ( N-1 ) / ( QQ( N-1 )+T1 ) ).LE.TOLX )
-     $           THEN
-               LDEF = .TRUE.
-            END IF
-         END IF
-      ELSE
-         IF( EE( N-2 ).LE.( QQ( N ) / ( QQ( N )+EE( N-1 )+QQ( N-1 ) ) )*
-     $       QQ( N-1 )*TOL2 ) THEN
-            LDEF = .TRUE.
-         END IF
-      END IF
-      IF( LDEF ) THEN
-         QEMAX = MAX( QQ( N ), QQ( N-1 ), EE( N-1 ) )
-         IF( QEMAX.NE.ZERO ) THEN
-            IF( QEMAX.EQ.QQ( N-1 ) ) THEN
-               XX = HALF*( QQ( N )+QQ( N-1 )+EE( N-1 )+QEMAX*
-     $              SQRT( ( ( QQ( N )-QQ( N-1 )+EE( N-1 ) ) /
-     $              QEMAX )**2+FOUR*EE( N-1 ) / QEMAX ) )
-            ELSE IF( QEMAX.EQ.QQ( N ) ) THEN
-               XX = HALF*( QQ( N )+QQ( N-1 )+EE( N-1 )+QEMAX*
-     $              SQRT( ( ( QQ( N-1 )-QQ( N )+EE( N-1 ) ) /
-     $              QEMAX )**2+FOUR*EE( N-1 ) / QEMAX ) )
-            ELSE
-               XX = HALF*( QQ( N )+QQ( N-1 )+EE( N-1 )+QEMAX*
-     $              SQRT( ( ( QQ( N )-QQ( N-1 )+EE( N-1 ) ) /
-     $              QEMAX )**2+FOUR*QQ( N-1 ) / QEMAX ) )
+      IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
+         IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
+            IPN4 = 4*( I0+N0 )
+            DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
+               TEMP = Z( J4-3 )
+               Z( J4-3 ) = Z( IPN4-J4-3 )
+               Z( IPN4-J4-3 ) = TEMP
+               TEMP = Z( J4-2 )
+               Z( J4-2 ) = Z( IPN4-J4-2 )
+               Z( IPN4-J4-2 ) = TEMP
+               TEMP = Z( J4-1 )
+               Z( J4-1 ) = Z( IPN4-J4-5 )
+               Z( IPN4-J4-5 ) = TEMP
+               TEMP = Z( J4 )
+               Z( J4 ) = Z( IPN4-J4-4 )
+               Z( IPN4-J4-4 ) = TEMP
+   60       CONTINUE
+            IF( N0-I0.LE.4 ) THEN
+               Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
+               Z( 4*N0-PP ) = Z( 4*I0-PP )
             END IF
-            YY = ( MAX( QQ( N ), QQ( N-1 ) ) / XX )*
-     $           MIN( QQ( N ), QQ( N-1 ) )
-         ELSE
-            XX = ZERO
-            YY = ZERO
-         END IF
-         Q( N-1 ) = SIGMA + XX
-         Q( N ) = YY + SIGMA
-         N = N - 2
-         ICONV = ICONV + 2
-         GO TO 90
-      END IF
-*
-*     Updating bounds before going to pong
-*
-      IF( ICONV.EQ.0 ) THEN
-         KEND = KE
-         SUP = MIN( DM, SUP-TAU )
-      ELSE IF( ICONV.GT.0 ) THEN
-         SUP = MIN( QQ( N ), QQ( N-1 ), QQ( N-2 ), QQ( 1 ), QQ( 2 ),
-     $         QQ( 3 ) )
-         IF( ICONV.EQ.1 ) THEN
-            KEND = K1END
-         ELSE IF( ICONV.EQ.2 ) THEN
-            KEND = K2END
-         ELSE
-            KEND = N
-         END IF
-         ICNT = 0
-         MAXIT = 100*N
-      END IF
-*
-*     Checking for splitting in ping
-*
-      LSPLIT = .FALSE.
-      DO 100 KS = N - 3, 3, -1
-         IF( EE( KS ).LE.TOLY ) THEN
-            IF( EE( KS )*( MIN( QQ( KS+1 ),
-     $          QQ( KS ) ) / ( MIN( QQ( KS+1 ), QQ( KS ) )+SIGMA ) ).LE.
-     $          TOLX ) THEN
-               LSPLIT = .TRUE.
-               GO TO 110
-            END IF
-         END IF
-  100 CONTINUE
-*
-      KS = 2
-      IF( EE( 2 ).LE.TOLZ ) THEN
-         LSPLIT = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         T1 = SIGMA + EE( 1 )*( SIGMA / ( SIGMA+QQ( 1 ) ) )
-         IF( EE( 2 )*( T1 / ( QQ( 1 )+T1 ) ).LE.TOLY ) THEN
-            IF( EE( 2 )*( QQ( 1 ) / ( QQ( 1 )+T1 ) ).LE.TOLX ) THEN
-               LSPLIT = .TRUE.
-            END IF
-         END IF
-      ELSE
-         IF( EE( 2 ).LE.( QQ( 1 ) / ( QQ( 1 )+EE( 1 )+QQ( 2 ) ) )*
-     $       QQ( 2 )*TOL2 ) THEN
-            LSPLIT = .TRUE.
-         END IF
-      END IF
-      IF( LSPLIT )
-     $   GO TO 110
-*
-      KS = 1
-      IF( EE( 1 ).LE.TOLZ ) THEN
-         LSPLIT = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         IF( EE( 1 ).LE.EPS*( SIGMA+QQ( 1 ) ) ) THEN
-            IF( EE( 1 )*( QQ( 1 ) / ( QQ( 1 )+SIGMA ) ).LE.TOL2*
-     $          ( QQ( 1 )+SIGMA ) ) THEN
-               LSPLIT = .TRUE.
-            END IF
-         END IF
-      ELSE
-         IF( EE( 1 ).LE.QQ( 1 )*TOL2 ) THEN
-            LSPLIT = .TRUE.
+            DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
+            Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
+     $                       Z( 4*I0+PP+3 ) )
+            Z( 4*I0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
+     $                     Z( 4*I0-PP+4 ) )
+            QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
+            DMIN = -ZERO
          END IF
       END IF
 *
-  110 CONTINUE
-      IF( LSPLIT ) THEN
-         SUP = MIN( QQ( N ), QQ( N-1 ), QQ( N-2 ) )
-         ISP = -( OFF+1 )
-         OFF = OFF + KS
-         N = N - KS
-         KEND = MAX( 1, KEND-KS )
-         E( KS ) = SIGMA
-         EE( KS ) = ISP
-         ICONV = 0
-         RETURN
-      END IF
+   70 CONTINUE
 *
-*     Coincidence
-*
-      IF( TAU.EQ.ZERO .AND. DM.LE.TOLZ .AND. KEND.NE.N .AND. ICONV.EQ.
-     $    0 .AND. ICNT.GT.0 ) THEN
-         CALL DCOPY( N-KE, E( KE ), 1, QQ( KE ), 1 )
-         QQ( N ) = ZERO
-         CALL DCOPY( N-KE, Q( KE+1 ), 1, EE( KE ), 1 )
-         SUP = ZERO
-      END IF
-      ICONV = 0
-      GO TO 130
+      IF( DMIN.LT.ZERO .OR. SFMIN*QMAX.LE.
+     $    MIN( Z( 4*N0+PP-1 ), Z( 4*N0+PP-9 ), DMIN2+Z( 4*N0-PP ) ) )
+     $     THEN
 *
-*     A new shift when the previous failed (in ping)
-*
-  120 CONTINUE
-      IFL = IFL + 1
-      SUP = TAU
-*
-*     SUP is small or
-*     Too many bad shifts (ping)
-*
-      IF( SUP.LE.TOLZ .OR. IFL.GE.IFLMAX ) THEN
-         TAU = ZERO
-         GO TO 40
+*        Choose a shift.
 *
-*     The asymptotic shift (in ping)
+         CALL DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
+     $                DN2, TAU, TTYPE )
 *
-      ELSE
-         TAU = MAX( TAU+D, ZERO )
-         IF( TAU.LE.TOLZ )
-     $      TAU = ZERO
-         GO TO 40
-      END IF
-*
-*     the pong section of the code
-*
-  130 CONTINUE
-      IFL = 0
+*        Call dqds until DMIN > 0.
 *
-*     Compute the shift (in pong)
+   80    CONTINUE
+*
+         CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN, DN1,
+     $                DN2 )
 *
-      IF( KEND.EQ.0 .AND. SUP.EQ.ZERO ) THEN
-         TAU = ZERO
-      ELSE IF( ICNT.GT.0 .AND. DM.LE.TOLZ ) THEN
-         TAU = ZERO
-      ELSE
-         IP = MAX( IPP, N / NPP )
-         N2 = 2*IP + 1
-         IF( N2.GE.N ) THEN
-            N1 = 1
-            N2 = N
-         ELSE IF( KEND+IP.GT.N ) THEN
-            N1 = N - 2*IP
-         ELSE IF( KEND-IP.LT.1 ) THEN
-            N1 = 1
-         ELSE
-            N1 = KEND - IP
-         END IF
-         CALL DLASQ4( N2, QQ( N1 ), EE( N1 ), TAU, SUP )
-      END IF
-  140 CONTINUE
-      ICNT = ICNT + 1
-      IF( ICNT.GT.MAXIT ) THEN
-         SUP = -SUP
-         RETURN
-      END IF
-      IF( TAU.EQ.ZERO ) THEN
+         ITER = ITER + 1
+         NDIV = NDIV + ( N0-I0+2 )
+*
+*        Check for NaN: "DMIN.NE.DMIN"
 *
-*     The dqd algorithm (in pong)
-*
-         D = QQ( 1 )
-         DM = D
-         KE = 0
-         DO 150 I = 1, N - 3
-            Q( I ) = D + EE( I )
-            D = ( D / Q( I ) )*QQ( I+1 )
-            IF( DM.GT.D ) THEN
-               DM = D
-               KE = I
-            END IF
-  150    CONTINUE
-         KE = KE + 1
-*
-*     Penultimate dqd step (in pong)
-*
-         K2END = KE
-         Q( N-2 ) = D + EE( N-2 )
-         D = ( D / Q( N-2 ) )*QQ( N-1 )
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N - 1
+         IF( DMIN.NE.DMIN ) THEN
+            Z( 4*N0+PP-1 ) = ZERO
+            TAU = ZERO
+            GO TO 70
          END IF
 *
-*     Final dqd step (in pong)
-*
-         K1END = KE
-         Q( N-1 ) = D + EE( N-1 )
-         D = ( D / Q( N-1 ) )*QQ( N )
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N
-         END IF
-         Q( N ) = D
-      ELSE
-*
-*     The dqds algorithm (in pong)
+*        Check for convergence hidden by negative DN.
 *
-         D = QQ( 1 ) - TAU
-         DM = D
-         KE = 0
-         IF( D.LT.ZERO )
-     $      GO TO 220
-         DO 160 I = 1, N - 3
-            Q( I ) = D + EE( I )
-            D = ( D / Q( I ) )*QQ( I+1 ) - TAU
-            IF( DM.GT.D ) THEN
-               DM = D
-               KE = I
-               IF( D.LT.ZERO )
-     $            GO TO 220
-            END IF
-  160    CONTINUE
-         KE = KE + 1
-*
-*     Penultimate dqds step (in pong)
-*
-         K2END = KE
-         Q( N-2 ) = D + EE( N-2 )
-         D = ( D / Q( N-2 ) )*QQ( N-1 ) - TAU
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N - 1
-            IF( D.LT.ZERO )
-     $         GO TO 220
+         IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
+     $       Z( 4*( N0-1 )-PP ).LT.EPS*( SIGMA+DN1 ) .AND. ABS( DN ).LT.
+     $       EPS*SIGMA ) THEN
+            Z( 4*( N0-1 )-PP+2 ) = ZERO
+            DMIN = ABS( DMIN )
          END IF
 *
-*     Final dqds step (in pong)
+         IF( DMIN.LT.ZERO ) THEN
+*
+*           Failure. Select new TAU and try again.
+*
+            NFAIL = NFAIL + 1
+*
+*           Failed twice. Play it safe.
+*
+            IF( TTYPE.LT.-22 ) THEN
+               TAU = ZERO
+               GO TO 80
+            END IF
+*
+            IF( DMIN1.GT.ZERO ) THEN
+*
+*              Late failure. Gives excellent shift.
 *
-         K1END = KE
-         Q( N-1 ) = D + EE( N-1 )
-         D = ( D / Q( N-1 ) )*QQ( N ) - TAU
-         IF( DM.GT.D ) THEN
-            DM = D
-            KE = N
+               TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
+               TTYPE = TTYPE - 11
+            ELSE
+*
+*              Early failure. Divide by 4.
+*
+               TAU = QURTR*TAU
+               TTYPE = TTYPE - 12
+            END IF
+            GO TO 80
          END IF
-         Q( N ) = D
+      ELSE
+         CALL DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
+         ITER = ITER + 1
+         NDIV = NDIV + ( N0-I0 )
+         TAU = ZERO
       END IF
 *
-*        Convergence when is small (in pong)
-*
-      IF( ABS( Q( N ) ).LE.SIGMA*TOL2 ) THEN
-         Q( N ) = ZERO
-         DM = ZERO
-         KE = N
-      END IF
-      IF( Q( N ).LT.ZERO )
-     $   GO TO 220
-*
-*     Non-negative qd array: Update the e's
-*
-      DO 170 I = 1, N - 1
-         E( I ) = ( EE( I ) / Q( I ) )*QQ( I+1 )
-  170 CONTINUE
-*
-*     Updating sigma and iphase in pong
-*
-      SIGMA = SIGMA + TAU
-  180 CONTINUE
-      IPHASE = 1
-      TOLX = SIGMA*TOL2
-      TOLY = SIGMA*EPS
-*
-*     Checking for deflation and convergence (in pong)
-*
-  190 CONTINUE
-      IF( N.LE.2 )
-     $   RETURN
-*
-*        Deflation: bottom 1x1 (in pong)
-*
-      LDEF = .FALSE.
-      IF( E( N-1 ).LE.TOLZ ) THEN
-         LDEF = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         IF( E( N-1 ).LE.EPS*( SIGMA+Q( N ) ) ) THEN
-            IF( E( N-1 )*( Q( N ) / ( Q( N )+SIGMA ) ).LE.TOL2*
-     $          ( Q( N )+SIGMA ) ) THEN
-               LDEF = .TRUE.
-            END IF
-         END IF
+      IF( TAU.LT.SIGMA ) THEN
+         DESIG = DESIG + TAU
+         T = SIGMA + DESIG
+         DESIG = DESIG - ( T-SIGMA )
       ELSE
-         IF( E( N-1 ).LE.Q( N )*TOL2 ) THEN
-            LDEF = .TRUE.
-         END IF
+         T = SIGMA + TAU
+         DESIG = SIGMA - ( T-TAU ) + DESIG
       END IF
-      IF( LDEF ) THEN
-         Q( N ) = Q( N ) + SIGMA
-         N = N - 1
-         ICONV = ICONV + 1
-         GO TO 190
-      END IF
-*
-*        Deflation: bottom 2x2 (in pong)
-*
-      LDEF = .FALSE.
-      IF( E( N-2 ).LE.TOLZ ) THEN
-         LDEF = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         T1 = SIGMA + E( N-1 )*( SIGMA / ( SIGMA+Q( N ) ) )
-         IF( E( N-2 )*( T1 / ( Q( N-1 )+T1 ) ).LE.TOLY ) THEN
-            IF( E( N-2 )*( Q( N-1 ) / ( Q( N-1 )+T1 ) ).LE.TOLX ) THEN
-               LDEF = .TRUE.
-            END IF
-         END IF
-      ELSE
-         IF( E( N-2 ).LE.( Q( N ) / ( Q( N )+EE( N-1 )+Q( N-1 ) )*Q( N-
-     $       1 ) )*TOL2 ) THEN
-            LDEF = .TRUE.
-         END IF
-      END IF
-      IF( LDEF ) THEN
-         QEMAX = MAX( Q( N ), Q( N-1 ), E( N-1 ) )
-         IF( QEMAX.NE.ZERO ) THEN
-            IF( QEMAX.EQ.Q( N-1 ) ) THEN
-               XX = HALF*( Q( N )+Q( N-1 )+E( N-1 )+QEMAX*
-     $              SQRT( ( ( Q( N )-Q( N-1 )+E( N-1 ) ) / QEMAX )**2+
-     $              FOUR*E( N-1 ) / QEMAX ) )
-            ELSE IF( QEMAX.EQ.Q( N ) ) THEN
-               XX = HALF*( Q( N )+Q( N-1 )+E( N-1 )+QEMAX*
-     $              SQRT( ( ( Q( N-1 )-Q( N )+E( N-1 ) ) / QEMAX )**2+
-     $              FOUR*E( N-1 ) / QEMAX ) )
-            ELSE
-               XX = HALF*( Q( N )+Q( N-1 )+E( N-1 )+QEMAX*
-     $              SQRT( ( ( Q( N )-Q( N-1 )+E( N-1 ) ) / QEMAX )**2+
-     $              FOUR*Q( N-1 ) / QEMAX ) )
-            END IF
-            YY = ( MAX( Q( N ), Q( N-1 ) ) / XX )*
-     $           MIN( Q( N ), Q( N-1 ) )
-         ELSE
-            XX = ZERO
-            YY = ZERO
-         END IF
-         Q( N-1 ) = SIGMA + XX
-         Q( N ) = YY + SIGMA
-         N = N - 2
-         ICONV = ICONV + 2
-         GO TO 190
-      END IF
-*
-*     Updating bounds before going to pong
+      SIGMA = T
 *
-      IF( ICONV.EQ.0 ) THEN
-         KEND = KE
-         SUP = MIN( DM, SUP-TAU )
-      ELSE IF( ICONV.GT.0 ) THEN
-         SUP = MIN( Q( N ), Q( N-1 ), Q( N-2 ), Q( 1 ), Q( 2 ), Q( 3 ) )
-         IF( ICONV.EQ.1 ) THEN
-            KEND = K1END
-         ELSE IF( ICONV.EQ.2 ) THEN
-            KEND = K2END
-         ELSE
-            KEND = N
-         END IF
-         ICNT = 0
-         MAXIT = 100*N
-      END IF
-*
-*     Checking for splitting in pong
-*
-      LSPLIT = .FALSE.
-      DO 200 KS = N - 3, 3, -1
-         IF( E( KS ).LE.TOLY ) THEN
-            IF( E( KS )*( MIN( Q( KS+1 ), Q( KS ) ) / ( MIN( Q( KS+1 ),
-     $          Q( KS ) )+SIGMA ) ).LE.TOLX ) THEN
-               LSPLIT = .TRUE.
-               GO TO 210
-            END IF
-         END IF
-  200 CONTINUE
-*
-      KS = 2
-      IF( E( 2 ).LE.TOLZ ) THEN
-         LSPLIT = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         T1 = SIGMA + E( 1 )*( SIGMA / ( SIGMA+Q( 1 ) ) )
-         IF( E( 2 )*( T1 / ( Q( 1 )+T1 ) ).LE.TOLY ) THEN
-            IF( E( 2 )*( Q( 1 ) / ( Q( 1 )+T1 ) ).LE.TOLX ) THEN
-               LSPLIT = .TRUE.
-            END IF
-         END IF
-      ELSE
-         IF( E( 2 ).LE.( Q( 1 ) / ( Q( 1 )+E( 1 )+Q( 2 ) ) )*Q( 2 )*
-     $       TOL2 ) THEN
-            LSPLIT = .TRUE.
-         END IF
-      END IF
-      IF( LSPLIT )
-     $   GO TO 210
-*
-      KS = 1
-      IF( E( 1 ).LE.TOLZ ) THEN
-         LSPLIT = .TRUE.
-      ELSE IF( SIGMA.GT.ZERO ) THEN
-         IF( E( 1 ).LE.EPS*( SIGMA+Q( 1 ) ) ) THEN
-            IF( E( 1 )*( Q( 1 ) / ( Q( 1 )+SIGMA ) ).LE.TOL2*
-     $          ( Q( 1 )+SIGMA ) ) THEN
-               LSPLIT = .TRUE.
-            END IF
-         END IF
-      ELSE
-         IF( E( 1 ).LE.Q( 1 )*TOL2 ) THEN
-            LSPLIT = .TRUE.
-         END IF
-      END IF
-*
-  210 CONTINUE
-      IF( LSPLIT ) THEN
-         SUP = MIN( Q( N ), Q( N-1 ), Q( N-2 ) )
-         ISP = OFF + 1
-         OFF = OFF + KS
-         KEND = MAX( 1, KEND-KS )
-         N = N - KS
-         E( KS ) = SIGMA
-         EE( KS ) = ISP
-         ICONV = 0
-         RETURN
-      END IF
-*
-*     Coincidence
-*
-      IF( TAU.EQ.ZERO .AND. DM.LE.TOLZ .AND. KEND.NE.N .AND. ICONV.EQ.
-     $    0 .AND. ICNT.GT.0 ) THEN
-         CALL DCOPY( N-KE, EE( KE ), 1, Q( KE ), 1 )
-         Q( N ) = ZERO
-         CALL DCOPY( N-KE, QQ( KE+1 ), 1, E( KE ), 1 )
-         SUP = ZERO
-      END IF
-      ICONV = 0
-      GO TO 30
-*
-*     Computation of a new shift when the previous failed (in pong)
-*
-  220 CONTINUE
-      IFL = IFL + 1
-      SUP = TAU
-*
-*     SUP is small or
-*     Too many bad shifts (in pong)
-*
-      IF( SUP.LE.TOLZ .OR. IFL.GE.IFLMAX ) THEN
-         TAU = ZERO
-         GO TO 140
-*
-*     The asymptotic shift (in pong)
-*
-      ELSE
-         TAU = MAX( TAU+D, ZERO )
-         IF( TAU.LE.TOLZ )
-     $      TAU = ZERO
-         GO TO 140
-      END IF
+      RETURN
 *
 *     End of DLASQ3
 *
diff --git a/libcruft/lapack/dlasq4.f b/libcruft/lapack/dlasq4.f
--- a/libcruft/lapack/dlasq4.f
+++ b/libcruft/lapack/dlasq4.f
@@ -1,101 +1,310 @@
-      SUBROUTINE DLASQ4( N, Q, E, TAU, SUP )
+      SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
+     $                   DN1, DN2, TAU, TTYPE )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
-      INTEGER            N
-      DOUBLE PRECISION   SUP, TAU
+      INTEGER            I0, N0, N0IN, PP, TTYPE
+      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   E( * ), Q( * )
+      DOUBLE PRECISION   Z( * )
 *     ..
 *
-*     Purpose
-*     =======
+*  Purpose
+*  =======
+*  DLASQ4 computes an approximation TAU to the smallest eigenvalue
+*  using values of d from the previous transform.
+*
+*  I0    (input) INTEGER
+*        First index.
+*
+*  N0    (input) INTEGER
+*        Last index.
 *
-*     DLASQ4 estimates TAU, the smallest eigenvalue of a matrix. This
-*     routine improves the input value of SUP which is an upper bound
-*     for the smallest eigenvalue for this matrix .
+*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )
+*        Z holds the qd array.
+*
+*  PP    (input) INTEGER
+*        PP=0 for ping, PP=1 for pong.
 *
-*     Arguments
-*     =========
+*  NOIN  (input) INTEGER
+*        The value of N0 at start of EIGTEST.
+*
+*  DMIN  (input) DOUBLE PRECISION
+*        Minimum value of d.
 *
-*  N       (input) INTEGER
-*          On entry, N specifies the number of rows and columns
-*          in the matrix. N must be at least 0.
+*  DMIN1 (input) DOUBLE PRECISION
+*        Minimum value of d, excluding D( N0 ).
+*
+*  DMIN2 (input) DOUBLE PRECISION
+*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
 *
-*  Q       (input) DOUBLE PRECISION array, dimension (N)
-*          Q array
+*  DN    (input) DOUBLE PRECISION
+*        d(N)
+*
+*  DN1   (input) DOUBLE PRECISION
+*        d(N-1)
 *
-*  E       (input) DOUBLE PRECISION array, dimension (N)
-*          E array
+*  DN2   (input) DOUBLE PRECISION
+*        d(N-2)
+*
+*  TAU   (output) DOUBLE PRECISION
+*        This is the shift.
 *
-*  TAU     (output) DOUBLE PRECISION
-*          Estimate of the shift
+*  TTYPE (output) INTEGER
+*        Shift type.
 *
-*  SUP     (input/output) DOUBLE PRECISION
-*          Upper bound for the smallest singular value
+*  Further Details
+*  ===============
+*  CNST1 = 9/16
 *
 *  =====================================================================
 *
 *     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-      DOUBLE PRECISION   BIS, BIS1
-      PARAMETER          ( BIS = 0.9999D+0, BIS1 = 0.7D+0 )
-      INTEGER            IFLMAX
-      PARAMETER          ( IFLMAX = 5 )
+      DOUBLE PRECISION   CNST1, CNST2, CNST3
+      PARAMETER          ( CNST1 = 0.5630D0, CNST2 = 1.010D0,
+     $                   CNST3 = 1.050D0 )
+      DOUBLE PRECISION   QURTR, THIRD, HALF, ZERO, ONE, TWO, HNDRD
+      PARAMETER          ( QURTR = 0.250D0, THIRD = 0.3330D0,
+     $                   HALF = 0.50D0, ZERO = 0.0D0, ONE = 1.0D0,
+     $                   TWO = 2.0D0, HNDRD = 100.0D0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IFL
-      DOUBLE PRECISION   D, DM, XINF
+      INTEGER            I4, NN, NP
+      DOUBLE PRECISION   A2, B1, B2, G, GAM, GAP1, GAP2, S
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Save statement ..
+      SAVE               G
+*     ..
+*     .. Data statements ..
+      DATA               G / ZERO /
 *     ..
 *     .. Executable Statements ..
-      IFL = 1
-      SUP = MIN( SUP, Q( 1 ), Q( 2 ), Q( 3 ), Q( N ), Q( N-1 ),
-     $      Q( N-2 ) )
-      TAU = SUP*BIS
-      XINF = ZERO
-   10 CONTINUE
-      IF( IFL.EQ.IFLMAX ) THEN
-         TAU = XINF
+*
+*     A negative DMIN forces the shift to take that absolute value
+*     TTYPE records the type of shift.
+*
+      IF( DMIN.LE.ZERO ) THEN
+         TAU = -DMIN
+         TTYPE = -1
          RETURN
       END IF
-      D = Q( 1 ) - TAU
-      DM = D
-      DO 20 I = 1, N - 2
-         D = ( D / ( D+E( I ) ) )*Q( I+1 ) - TAU
-         IF( DM.GT.D )
-     $      DM = D
-         IF( D.LT.ZERO ) THEN
-            SUP = TAU
-            TAU = MAX( SUP*BIS1**IFL, D+TAU )
-            IFL = IFL + 1
-            GO TO 10
+*
+      NN = 4*N0 + PP
+      IF( N0IN.EQ.N0 ) THEN
+*
+*        No eigenvalues deflated.
+*
+         IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
+*
+            B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
+            B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
+            A2 = Z( NN-7 ) + Z( NN-5 )
+*
+*           Cases 2 and 3.
+*
+            IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
+               GAP2 = DMIN2 - A2 - DMIN2*QURTR
+               IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
+                  GAP1 = A2 - DN - ( B2 / GAP2 )*B2
+               ELSE
+                  GAP1 = A2 - DN - ( B1+B2 )
+               END IF
+               IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
+                  S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
+                  TTYPE = -2
+               ELSE
+                  S = ZERO
+                  IF( DN.GT.B1 )
+     $               S = DN - B1
+                  IF( A2.GT.( B1+B2 ) )
+     $               S = MIN( S, A2-( B1+B2 ) )
+                  S = MAX( S, THIRD*DMIN )
+                  TTYPE = -3
+               END IF
+            ELSE
+*
+*              Case 4.
+*
+               IF( DMIN.EQ.DN ) THEN
+                  GAM = DN
+                  A2 = ZERO
+                  B2 = Z( NN-5 ) / Z( NN-7 )
+                  NP = NN - 9
+               ELSE
+                  NP = NN - 2*PP
+                  B2 = Z( NP-2 )
+                  GAM = DN1
+                  A2 = Z( NP-4 ) / Z( NP-2 )
+                  B2 = Z( NN-9 ) / Z( NN-11 )
+                  NP = NN - 13
+               END IF
+*
+*              Approximate contribution to norm squared from I < NN-1.
+*
+               IF( B2.EQ.ZERO )
+     $            GO TO 20
+               A2 = A2 + B2
+               DO 10 I4 = NP, 4*I0 - 1 + PP, -4
+                  B1 = B2
+                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
+                  A2 = A2 + B2
+                  IF( HNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
+     $               GO TO 20
+   10          CONTINUE
+   20          CONTINUE
+               A2 = CNST3*A2
+*
+*              Rayleigh quotient residual bound.
+*
+               IF( A2.LT.CNST1 ) THEN
+                  S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
+               ELSE
+                  S = QURTR*GAM
+               END IF
+               TTYPE = -4
+            END IF
+         ELSE IF( DMIN.EQ.DN2 ) THEN
+*
+*           Case 5.
+*
+*           Compute contribution to norm squared from I > NN-2.
+*
+            NP = NN - 2*PP
+            B1 = Z( NP-2 )
+            B2 = Z( NP-6 )
+            GAM = DN2
+            A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
+*
+*           Approximate contribution to norm squared from I < NN-2.
+*
+            IF( N0-I0.GT.2 ) THEN
+               B2 = Z( NN-13 ) / Z( NN-15 )
+               IF( B2.EQ.ZERO )
+     $            GO TO 40
+               A2 = A2 + B2
+               DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
+                  B1 = B2
+                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
+                  A2 = A2 + B2
+                  IF( HNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
+     $               GO TO 40
+   30          CONTINUE
+   40          CONTINUE
+               A2 = CNST3*A2
+            END IF
+*
+            IF( A2.LT.CNST1 ) THEN
+               S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
+            ELSE
+               S = QURTR*GAM / ( ONE+A2 )
+            END IF
+            TTYPE = -5
+         ELSE
+*
+*           Case 6, no information to guide us.
+*
+            IF( TTYPE.EQ.-6 ) THEN
+               G = G + THIRD*( ONE-G )
+            ELSE IF( TTYPE.EQ.-18 ) THEN
+               G = QURTR*THIRD
+            ELSE
+               G = QURTR
+            END IF
+            S = G*DMIN
+            TTYPE = -6
          END IF
-   20 CONTINUE
-      D = ( D / ( D+E( N-1 ) ) )*Q( N ) - TAU
-      IF( DM.GT.D )
-     $   DM = D
-      IF( D.LT.ZERO ) THEN
-         SUP = TAU
-         XINF = MAX( XINF, D+TAU )
-         IF( SUP*BIS1**IFL.LE.XINF ) THEN
-            TAU = XINF
+*
+      ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
+*
+*        One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
+*
+         IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN
+*
+*           Cases 7 and 8.
+*
+            B1 = Z( NN-5 ) / Z( NN-7 )
+            B2 = B1
+            IF( B2.EQ.ZERO )
+     $         GO TO 60
+            DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
+               A2 = B1
+               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
+               B2 = B2 + B1
+               IF( HNDRD*MAX( B1, A2 ).LT.B2 )
+     $            GO TO 60
+   50       CONTINUE
+   60       CONTINUE
+            B2 = SQRT( CNST3*B2 )
+            A2 = DMIN1 / ( ONE+B2**2 )
+            GAP2 = HALF*DMIN2 - A2
+            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
+               S = MAX( A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ),
+     $             THIRD*DMIN1 )
+               TTYPE = -7
+            ELSE
+               S = MAX( A2*( ONE-CNST2*B2 ), THIRD*DMIN1 )
+               TTYPE = -8
+            END IF
          ELSE
-            TAU = SUP*BIS1**IFL
-            IFL = IFL + 1
-            GO TO 10
+*
+*           Case 9.
+*
+            S = QURTR*DMIN1
+            IF( DMIN1.EQ.DN1 )
+     $         S = HALF*DMIN1
+            TTYPE = -9
          END IF
-      ELSE
-         SUP = MIN( SUP, DM+TAU )
+*
+      ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
+*
+*        Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
+*
+*        Cases 10 and 11.
+*
+         IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN
+            B1 = Z( NN-5 ) / Z( NN-7 )
+            B2 = B1
+            IF( B2.EQ.ZERO )
+     $         GO TO 80
+            DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
+               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
+               B2 = B2 + B1
+               IF( HNDRD*B1.LT.B2 )
+     $            GO TO 80
+   70       CONTINUE
+   80       CONTINUE
+            B2 = SQRT( CNST3*B2 )
+            A2 = DMIN2 / ( ONE+B2**2 )
+            GAP2 = Z( NN-7 ) + Z( NN-9 ) -
+     $             SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
+            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
+               S = MAX( A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ),
+     $             THIRD*DMIN2 )
+            ELSE
+               S = MAX( A2*( ONE-CNST2*B2 ), THIRD*DMIN2 )
+            END IF
+            TTYPE = -10
+         ELSE
+            S = QURTR*DMIN2
+            TTYPE = -11
+         END IF
+      ELSE IF( N0IN.GT.( N0+2 ) ) THEN
+*
+*        Case 12, more than two eigenvalues deflated. No information.
+*
+         S = ZERO
+         TTYPE = -12
       END IF
+*
+      TAU = S
       RETURN
 *
 *     End of DLASQ4
diff --git a/libcruft/lapack/dlasq5.f b/libcruft/lapack/dlasq5.f
new file mode 100644
--- /dev/null
+++ b/libcruft/lapack/dlasq5.f
@@ -0,0 +1,122 @@
+      SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
+     $                   DNM1, DNM2 )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     June 30, 1999
+*
+*     .. Scalar Arguments ..
+      INTEGER            I0, N0, PP
+      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   Z( * )
+*     ..
+*
+*  Purpose
+*  =======
+*  DLASQ5 computes one dqds transform in ping-pong form.
+*
+*  Arguments
+*  =========
+*
+*  I0    (input) INTEGER
+*        First index.
+*
+*  N0    (input) INTEGER
+*        Last index.
+*
+*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )
+*        Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+*        an extra argument.
+*
+*  PP    (input) INTEGER
+*        PP=0 for ping, PP=1 for pong.
+*
+*  TAU   (input) DOUBLE PRECISION
+*        This is the shift.
+*
+*  DMIN  (output) DOUBLE PRECISION
+*        Minimum value of d.
+*
+*  DMIN1 (output) DOUBLE PRECISION
+*        Minimum value of d, excluding D( N0 ).
+*
+*  DMIN2 (output) DOUBLE PRECISION
+*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+*
+*  DN    (output) DOUBLE PRECISION
+*        d(N0), the last value of d.
+*
+*  DNM1  (output) DOUBLE PRECISION
+*        d(N0-1).
+*
+*  DNM2  (output) DOUBLE PRECISION
+*        d(N0-2).
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER            J4, J4P2
+      DOUBLE PRECISION   D, EMIN, TEMP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN
+*     ..
+*     .. Executable Statements ..
+*
+      IF( ( N0-I0-1 ).LE.0 )
+     $   RETURN
+*
+      J4 = 4*I0 + PP - 3
+      EMIN = Z( J4+4 )
+      D = Z( J4 ) - TAU
+      DMIN = D
+*
+      IF( PP.EQ.0 ) THEN
+         DO 10 J4 = 4*I0, 4*( N0-3 ), 4
+            Z( J4-2 ) = D + Z( J4-1 )
+            TEMP = Z( J4+1 ) / Z( J4-2 )
+            D = D*TEMP - TAU
+            DMIN = MIN( DMIN, D )
+            Z( J4 ) = Z( J4-1 )*TEMP
+            EMIN = MIN( Z( J4 ), EMIN )
+   10    CONTINUE
+      ELSE
+         DO 20 J4 = 4*I0, 4*( N0-3 ), 4
+            Z( J4-3 ) = D + Z( J4 )
+            TEMP = Z( J4+2 ) / Z( J4-3 )
+            D = D*TEMP - TAU
+            DMIN = MIN( DMIN, D )
+            Z( J4-1 ) = Z( J4 )*TEMP
+            EMIN = MIN( Z( J4-1 ), EMIN )
+   20    CONTINUE
+      END IF
+*
+*     Unroll last two steps.
+*
+      DNM2 = D
+      DMIN2 = DMIN
+      J4 = 4*( N0-2 ) - PP
+      J4P2 = J4 + 2*PP - 1
+      Z( J4-2 ) = DNM2 + Z( J4P2 )
+      Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
+      DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
+      DMIN = MIN( DMIN, DNM1 )
+*
+      DMIN1 = DMIN
+      J4 = J4 + 4
+      J4P2 = J4 + 2*PP - 1
+      Z( J4-2 ) = DNM1 + Z( J4P2 )
+      Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
+      DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
+      DMIN = MIN( DMIN, DN )
+*
+      Z( J4+2 ) = DN
+      Z( 4*N0-PP ) = EMIN
+      RETURN
+*
+*     End of DLASQ5
+*
+      END
diff --git a/libcruft/lapack/dlasq6.f b/libcruft/lapack/dlasq6.f
new file mode 100644
--- /dev/null
+++ b/libcruft/lapack/dlasq6.f
@@ -0,0 +1,150 @@
+      SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DNM1,
+     $                   DNM2 )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     June 30, 1999
+*
+*     .. Scalar Arguments ..
+      INTEGER            I0, N0, PP
+      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   Z( * )
+*     ..
+*
+*  Purpose
+*  =======
+*  DLASQ6 computes one dqds transform in ping-pong form.
+*
+*  Arguments
+*  =========
+*
+*  I0    (input) INTEGER
+*        First index.
+*
+*  N0    (input) INTEGER
+*        Last index.
+*
+*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )
+*        Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+*        an extra argument.
+*
+*  PP    (input) INTEGER
+*        PP=0 for ping, PP=1 for pong.
+*
+*  DMIN  (output) DOUBLE PRECISION
+*        Minimum value of d.
+*
+*  DMIN1 (output) DOUBLE PRECISION
+*        Minimum value of d, excluding D( N0 ).
+*
+*  DMIN2 (output) DOUBLE PRECISION
+*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+*
+*  DN    (output) DOUBLE PRECISION
+*        d(N0), the last value of d.
+*
+*  DNM1  (output) DOUBLE PRECISION
+*        d(N0-1).
+*
+*  DNM2  (output) DOUBLE PRECISION
+*        d(N0-2).
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            J4, J4P2
+      DOUBLE PRECISION   D, EMIN, SFMIN, TEMP
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           DLAMCH
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN
+*     ..
+*     .. Executable Statements ..
+*
+      IF( ( N0-I0-1 ).LE.0 )
+     $   RETURN
+*
+      SFMIN = DLAMCH( 'Safe minimum' )
+      J4 = 4*I0 + PP - 3
+      EMIN = Z( J4+4 )
+      D = Z( J4 )
+      DMIN = D
+*
+      DO 10 J4 = 4*I0 - PP, 4*( N0-3 ) - PP, 4
+         J4P2 = J4 + 2*PP - 1
+         Z( J4-2 ) = D + Z( J4P2 )
+         IF( Z( J4-2 ).EQ.ZERO ) THEN
+            Z( J4 ) = ZERO
+            D = Z( J4P2+2 )
+            DMIN = D
+            EMIN = ZERO
+         ELSE IF( SFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) ) THEN
+            TEMP = Z( J4P2+2 ) / Z( J4-2 )
+            Z( J4 ) = Z( J4P2 )*TEMP
+            D = D*TEMP
+         ELSE
+            Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
+            D = Z( J4P2+2 )*( D / Z( J4-2 ) )
+         END IF
+         DMIN = MIN( DMIN, D )
+         EMIN = MIN( EMIN, Z( J4 ) )
+   10 CONTINUE
+*
+*     Unroll last two steps.
+*
+      DNM2 = D
+      DMIN2 = DMIN
+      J4 = 4*( N0-2 ) - PP
+      J4P2 = J4 + 2*PP - 1
+      Z( J4-2 ) = DNM2 + Z( J4P2 )
+      IF( Z( J4-2 ).EQ.ZERO ) THEN
+         Z( J4 ) = ZERO
+         DNM1 = Z( J4P2+2 )
+         DMIN = DNM1
+         EMIN = ZERO
+      ELSE IF( SFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) ) THEN
+         TEMP = Z( J4P2+2 ) / Z( J4-2 )
+         Z( J4 ) = Z( J4P2 )*TEMP
+         DNM1 = DNM2*TEMP
+      ELSE
+         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
+         DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) )
+      END IF
+      DMIN = MIN( DMIN, DNM1 )
+*
+      DMIN1 = DMIN
+      J4 = J4 + 4
+      J4P2 = J4 + 2*PP - 1
+      Z( J4-2 ) = DNM1 + Z( J4P2 )
+      IF( Z( J4-2 ).EQ.ZERO ) THEN
+         Z( J4 ) = ZERO
+         DN = Z( J4P2+2 )
+         DMIN = DN
+         EMIN = ZERO
+      ELSE IF( SFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) ) THEN
+         TEMP = Z( J4P2+2 ) / Z( J4-2 )
+         Z( J4 ) = Z( J4P2 )*TEMP
+         DN = DNM1*TEMP
+      ELSE
+         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
+         DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) )
+      END IF
+      DMIN = MIN( DMIN, DN )
+*
+      Z( J4+2 ) = DN
+      Z( 4*N0-PP ) = EMIN
+      RETURN
+*
+*     End of DLASQ6
+*
+      END
diff --git a/libcruft/lapack/dlasr.f b/libcruft/lapack/dlasr.f
--- a/libcruft/lapack/dlasr.f
+++ b/libcruft/lapack/dlasr.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlasrt.f b/libcruft/lapack/dlasrt.f
--- a/libcruft/lapack/dlasrt.f
+++ b/libcruft/lapack/dlasrt.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLASRT( ID, N, D, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dlassq.f b/libcruft/lapack/dlassq.f
--- a/libcruft/lapack/dlassq.f
+++ b/libcruft/lapack/dlassq.f
@@ -1,9 +1,9 @@
       SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INCX, N
@@ -36,7 +36,7 @@
 *  N       (input) INTEGER
 *          The number of elements to be used from the vector X.
 *
-*  X       (input) DOUBLE PRECISION
+*  X       (input) DOUBLE PRECISION array, dimension (N)
 *          The vector for which a scaled sum of squares is computed.
 *             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
 *
diff --git a/libcruft/lapack/dlasv2.f b/libcruft/lapack/dlasv2.f
--- a/libcruft/lapack/dlasv2.f
+++ b/libcruft/lapack/dlasv2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlaswp.f b/libcruft/lapack/dlaswp.f
--- a/libcruft/lapack/dlaswp.f
+++ b/libcruft/lapack/dlaswp.f
@@ -1,9 +1,9 @@
       SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INCX, K1, K2, LDA, N
@@ -50,45 +50,67 @@
 *          The increment between successive values of IPIV.  If IPIV
 *          is negative, the pivots are applied in reverse order.
 *
+*  Further Details
+*  ===============
+*
+*  Modified by
+*   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
 * =====================================================================
 *
 *     .. Local Scalars ..
-      INTEGER            I, IP, IX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSWAP
+      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
+      DOUBLE PRECISION   TEMP
 *     ..
 *     .. Executable Statements ..
 *
 *     Interchange row I with row IPIV(I) for each of rows K1 through K2.
 *
-      IF( INCX.EQ.0 )
-     $   RETURN
       IF( INCX.GT.0 ) THEN
-         IX = K1
+         IX0 = K1
+         I1 = K1
+         I2 = K2
+         INC = 1
+      ELSE IF( INCX.LT.0 ) THEN
+         IX0 = 1 + ( 1-K2 )*INCX
+         I1 = K2
+         I2 = K1
+         INC = -1
       ELSE
-         IX = 1 + ( 1-K2 )*INCX
+         RETURN
       END IF
-      IF( INCX.EQ.1 ) THEN
-         DO 10 I = K1, K2
-            IP = IPIV( I )
-            IF( IP.NE.I )
-     $         CALL DSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA )
-   10    CONTINUE
-      ELSE IF( INCX.GT.1 ) THEN
-         DO 20 I = K1, K2
+*
+      N32 = ( N / 32 )*32
+      IF( N32.NE.0 ) THEN
+         DO 30 J = 1, N32, 32
+            IX = IX0
+            DO 20 I = I1, I2, INC
+               IP = IPIV( IX )
+               IF( IP.NE.I ) THEN
+                  DO 10 K = J, J + 31
+                     TEMP = A( I, K )
+                     A( I, K ) = A( IP, K )
+                     A( IP, K ) = TEMP
+   10             CONTINUE
+               END IF
+               IX = IX + INCX
+   20       CONTINUE
+   30    CONTINUE
+      END IF
+      IF( N32.NE.N ) THEN
+         N32 = N32 + 1
+         IX = IX0
+         DO 50 I = I1, I2, INC
             IP = IPIV( IX )
-            IF( IP.NE.I )
-     $         CALL DSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA )
+            IF( IP.NE.I ) THEN
+               DO 40 K = N32, N
+                  TEMP = A( I, K )
+                  A( I, K ) = A( IP, K )
+                  A( IP, K ) = TEMP
+   40          CONTINUE
+            END IF
             IX = IX + INCX
-   20    CONTINUE
-      ELSE IF( INCX.LT.0 ) THEN
-         DO 30 I = K2, K1, -1
-            IP = IPIV( IX )
-            IF( IP.NE.I )
-     $         CALL DSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA )
-            IX = IX + INCX
-   30    CONTINUE
+   50    CONTINUE
       END IF
 *
       RETURN
diff --git a/libcruft/lapack/dlasy2.f b/libcruft/lapack/dlasy2.f
--- a/libcruft/lapack/dlasy2.f
+++ b/libcruft/lapack/dlasy2.f
@@ -1,7 +1,7 @@
       SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
      $                   LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dlatrd.f b/libcruft/lapack/dlatrd.f
--- a/libcruft/lapack/dlatrd.f
+++ b/libcruft/lapack/dlatrd.f
@@ -1,6 +1,6 @@
       SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dorg2l.f b/libcruft/lapack/dorg2l.f
--- a/libcruft/lapack/dorg2l.f
+++ b/libcruft/lapack/dorg2l.f
@@ -1,6 +1,6 @@
       SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dorg2r.f b/libcruft/lapack/dorg2r.f
--- a/libcruft/lapack/dorg2r.f
+++ b/libcruft/lapack/dorg2r.f
@@ -1,6 +1,6 @@
       SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dorgbr.f b/libcruft/lapack/dorgbr.f
--- a/libcruft/lapack/dorgbr.f
+++ b/libcruft/lapack/dorgbr.f
@@ -1,16 +1,16 @@
       SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          VECT
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -84,6 +84,11 @@
 *          For optimum performance LWORK >= min(M,N)*NB, where NB
 *          is the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -95,12 +100,13 @@
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            WANTQ
-      INTEGER            I, IINFO, J
+      LOGICAL            LQUERY, WANTQ
+      INTEGER            I, IINFO, J, LWKOPT, MN, NB
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DORGLQ, DORGQR, XERBLA
@@ -114,6 +120,8 @@
 *
       INFO = 0
       WANTQ = LSAME( VECT, 'Q' )
+      MN = MIN( M, N )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
          INFO = -1
       ELSE IF( M.LT.0 ) THEN
@@ -126,12 +134,25 @@
          INFO = -4
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -6
-      ELSE IF( LWORK.LT.MAX( 1, MIN( M, N ) ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
          INFO = -9
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( WANTQ ) THEN
+            NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
+         ELSE
+            NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
+         END IF
+         LWKOPT = MAX( 1, MN )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORGBR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -216,6 +237,7 @@
             END IF
          END IF
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of DORGBR
diff --git a/libcruft/lapack/dorghr.f b/libcruft/lapack/dorghr.f
--- a/libcruft/lapack/dorghr.f
+++ b/libcruft/lapack/dorghr.f
@@ -1,15 +1,15 @@
       SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -54,6 +54,11 @@
 *          For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -65,11 +70,16 @@
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IINFO, J, NH
+      LOGICAL            LQUERY
+      INTEGER            I, IINFO, J, LWKOPT, NB, NH
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DORGQR, XERBLA
 *     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
@@ -78,6 +88,8 @@
 *     Test the input arguments
 *
       INFO = 0
+      NH = IHI - ILO
+      LQUERY = ( LWORK.EQ.-1 )
       IF( N.LT.0 ) THEN
          INFO = -1
       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
@@ -86,12 +98,21 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, IHI-ILO ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         NB = ILAENV( 1, 'DORGQR', ' ', NH, NH, NH, -1 )
+         LWKOPT = MAX( 1, NH )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORGHR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -129,7 +150,6 @@
          A( J, J ) = ONE
    80 CONTINUE
 *
-      NH = IHI - ILO
       IF( NH.GT.0 ) THEN
 *
 *        Generate Q(ilo+1:ihi,ilo+1:ihi)
@@ -137,6 +157,7 @@
          CALL DORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
      $                WORK, LWORK, IINFO )
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of DORGHR
diff --git a/libcruft/lapack/dorgl2.f b/libcruft/lapack/dorgl2.f
--- a/libcruft/lapack/dorgl2.f
+++ b/libcruft/lapack/dorgl2.f
@@ -1,9 +1,9 @@
       SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     February 29, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, M, N
@@ -121,7 +121,7 @@
          END IF
          A( I, I ) = ONE - TAU( I )
 *
-*        Set A(1:i-1,i) to zero
+*        Set A(i,1:i-1) to zero
 *
          DO 30 L = 1, I - 1
             A( I, L ) = ZERO
diff --git a/libcruft/lapack/dorglq.f b/libcruft/lapack/dorglq.f
--- a/libcruft/lapack/dorglq.f
+++ b/libcruft/lapack/dorglq.f
@@ -1,15 +1,15 @@
       SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -57,6 +57,11 @@
 *          For optimum performance LWORK >= M*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument has an illegal value
@@ -68,8 +73,9 @@
       PARAMETER          ( ZERO = 0.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK, NB,
-     $                   NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
+     $                   LWKOPT, NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DLARFB, DLARFT, DORGL2, XERBLA
@@ -86,6 +92,10 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
+      LWKOPT = MAX( 1, M )*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.M ) THEN
@@ -94,12 +104,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, M ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORGLQ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -109,9 +121,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
       NBMIN = 2
       NX = 0
       IWS = M
diff --git a/libcruft/lapack/dorgql.f b/libcruft/lapack/dorgql.f
--- a/libcruft/lapack/dorgql.f
+++ b/libcruft/lapack/dorgql.f
@@ -1,15 +1,15 @@
       SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -58,6 +58,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument has an illegal value
@@ -69,8 +74,9 @@
       PARAMETER          ( ZERO = 0.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, J, KK, L, LDWORK, NB, NBMIN,
-     $                   NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
+     $                   NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DLARFB, DLARFT, DORG2L, XERBLA
@@ -87,6 +93,10 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'DORGQL', ' ', M, N, K, -1 )
+      LWKOPT = MAX( 1, N )*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
@@ -95,12 +105,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORGQL', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -110,9 +122,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'DORGQL', ' ', M, N, K, -1 )
       NBMIN = 2
       NX = 0
       IWS = N
diff --git a/libcruft/lapack/dorgqr.f b/libcruft/lapack/dorgqr.f
--- a/libcruft/lapack/dorgqr.f
+++ b/libcruft/lapack/dorgqr.f
@@ -1,15 +1,15 @@
       SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -58,6 +58,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument has an illegal value
@@ -69,8 +74,9 @@
       PARAMETER          ( ZERO = 0.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK, NB,
-     $                   NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
+     $                   LWKOPT, NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DLARFB, DLARFT, DORG2R, XERBLA
@@ -87,6 +93,10 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
+      LWKOPT = MAX( 1, N )*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
@@ -95,12 +105,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORGQR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -110,9 +122,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
       NBMIN = 2
       NX = 0
       IWS = N
diff --git a/libcruft/lapack/dorgtr.f b/libcruft/lapack/dorgtr.f
--- a/libcruft/lapack/dorgtr.f
+++ b/libcruft/lapack/dorgtr.f
@@ -1,16 +1,16 @@
       SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
       INTEGER            INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -56,6 +56,11 @@
 *          For optimum performance LWORK >= (N-1)*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -67,12 +72,13 @@
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            I, IINFO, J
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, J, LWKOPT, NB
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DORGQL, DORGQR, XERBLA
@@ -85,6 +91,7 @@
 *     Test the input arguments
 *
       INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
       UPPER = LSAME( UPLO, 'U' )
       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
@@ -92,12 +99,25 @@
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, N-1 ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( UPPER ) THEN
+            NB = ILAENV( 1, 'DORGQL', ' ', N-1, N-1, N-1, -1 )
+         ELSE
+            NB = ILAENV( 1, 'DORGQR', ' ', N-1, N-1, N-1, -1 )
+         END IF
+         LWKOPT = MAX( 1, N-1 )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORGTR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -156,6 +176,7 @@
      $                   LWORK, IINFO )
          END IF
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of DORGTR
diff --git a/libcruft/lapack/dorm2r.f b/libcruft/lapack/dorm2r.f
--- a/libcruft/lapack/dorm2r.f
+++ b/libcruft/lapack/dorm2r.f
@@ -1,7 +1,7 @@
       SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dormbr.f b/libcruft/lapack/dormbr.f
--- a/libcruft/lapack/dormbr.f
+++ b/libcruft/lapack/dormbr.f
@@ -1,18 +1,17 @@
       SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
      $                   LDC, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          SIDE, TRANS, VECT
       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ),
-     $                   WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -110,6 +109,11 @@
 *          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
 *          blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -117,13 +121,14 @@
 *  =====================================================================
 *
 *     .. Local Scalars ..
-      LOGICAL            APPLYQ, LEFT, NOTRAN
+      LOGICAL            APPLYQ, LEFT, LQUERY, NOTRAN
       CHARACTER          TRANST
-      INTEGER            I1, I2, IINFO, MI, NI, NQ, NW
+      INTEGER            I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DORMLQ, DORMQR, XERBLA
@@ -139,6 +144,7 @@
       APPLYQ = LSAME( VECT, 'Q' )
       LEFT = LSAME( SIDE, 'L' )
       NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
 *     NQ is the order of Q or P and NW is the minimum dimension of WORK
 *
@@ -167,12 +173,37 @@
          INFO = -8
       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
          INFO = -11
-      ELSE IF( LWORK.LT.MAX( 1, NW ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
          INFO = -13
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( APPLYQ ) THEN
+            IF( LEFT ) THEN
+               NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M-1, N, M-1,
+     $              -1 )
+            ELSE
+               NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N-1, N-1,
+     $              -1 )
+            END IF
+         ELSE
+            IF( LEFT ) THEN
+               NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M-1, N, M-1,
+     $              -1 )
+            ELSE
+               NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N-1, N-1,
+     $              -1 )
+            END IF
+         END IF
+         LWKOPT = MAX( 1, NW )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORMBR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -243,6 +274,7 @@
      $                   TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
          END IF
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of DORMBR
diff --git a/libcruft/lapack/dorml2.f b/libcruft/lapack/dorml2.f
--- a/libcruft/lapack/dorml2.f
+++ b/libcruft/lapack/dorml2.f
@@ -1,7 +1,7 @@
       SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dormlq.f b/libcruft/lapack/dormlq.f
--- a/libcruft/lapack/dormlq.f
+++ b/libcruft/lapack/dormlq.f
@@ -1,18 +1,17 @@
       SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          SIDE, TRANS
       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ),
-     $                   WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -88,6 +87,11 @@
 *          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
 *          blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -99,10 +103,10 @@
       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
+      LOGICAL            LEFT, LQUERY, NOTRAN
       CHARACTER          TRANST
       INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   MI, NB, NBMIN, NI, NQ, NW
+     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
 *     ..
 *     .. Local Arrays ..
       DOUBLE PRECISION   T( LDT, NBMAX )
@@ -125,6 +129,7 @@
       INFO = 0
       LEFT = LSAME( SIDE, 'L' )
       NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
 *     NQ is the order of Q and NW is the minimum dimension of WORK
 *
@@ -149,12 +154,26 @@
          INFO = -7
       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
          INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
          INFO = -12
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size.  NB may be at most NBMAX, where NBMAX
+*        is used to define the local array T.
+*
+         NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K,
+     $        -1 ) )
+         LWKOPT = MAX( 1, NW )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORMLQ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -164,11 +183,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.  NB may be at most NBMAX, where NBMAX
-*     is used to define the local array T.
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K,
-     $     -1 ) )
       NBMIN = 2
       LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN
@@ -246,7 +260,7 @@
      $                   LDWORK )
    10    CONTINUE
       END IF
-      WORK( 1 ) = IWS
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of DORMLQ
diff --git a/libcruft/lapack/dormqr.f b/libcruft/lapack/dormqr.f
--- a/libcruft/lapack/dormqr.f
+++ b/libcruft/lapack/dormqr.f
@@ -1,18 +1,17 @@
       SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          SIDE, TRANS
       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ),
-     $                   WORK( LWORK )
+      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -88,6 +87,11 @@
 *          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
 *          blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -99,9 +103,9 @@
       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
+      LOGICAL            LEFT, LQUERY, NOTRAN
       INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   MI, NB, NBMIN, NI, NQ, NW
+     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
 *     ..
 *     .. Local Arrays ..
       DOUBLE PRECISION   T( LDT, NBMAX )
@@ -124,6 +128,7 @@
       INFO = 0
       LEFT = LSAME( SIDE, 'L' )
       NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
 *     NQ is the order of Q and NW is the minimum dimension of WORK
 *
@@ -148,12 +153,26 @@
          INFO = -7
       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
          INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
          INFO = -12
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size.  NB may be at most NBMAX, where NBMAX
+*        is used to define the local array T.
+*
+         NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
+     $        -1 ) )
+         LWKOPT = MAX( 1, NW )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DORMQR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -163,11 +182,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.  NB may be at most NBMAX, where NBMAX
-*     is used to define the local array T.
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
-     $     -1 ) )
       NBMIN = 2
       LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN
@@ -239,7 +253,7 @@
      $                   WORK, LDWORK )
    10    CONTINUE
       END IF
-      WORK( 1 ) = IWS
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of DORMQR
diff --git a/libcruft/lapack/dpotf2.f b/libcruft/lapack/dpotf2.f
--- a/libcruft/lapack/dpotf2.f
+++ b/libcruft/lapack/dpotf2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO )
 *
-*  -- LAPACK routine (version 1.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/dpotrf.f b/libcruft/lapack/dpotrf.f
--- a/libcruft/lapack/dpotrf.f
+++ b/libcruft/lapack/dpotrf.f
@@ -1,9 +1,9 @@
       SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
 *
-*  -- LAPACK routine (version 1.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     February 29, 1992
+*     March 31, 1993
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
@@ -20,8 +20,8 @@
 *  positive definite matrix A.
 *
 *  The factorization has the form
-*     A = U' * U ,  if UPLO = 'U', or
-*     A = L  * L',  if UPLO = 'L',
+*     A = U**T * U,  if UPLO = 'U', or
+*     A = L  * L**T,  if UPLO = 'L',
 *  where U is an upper triangular matrix and L is lower triangular.
 *
 *  This is the block version of the algorithm, calling Level 3 BLAS.
@@ -30,35 +30,33 @@
 *  =========
 *
 *  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is stored.
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
+*          = 'U':  Upper triangle of A is stored;
+*          = 'L':  Lower triangle of A is stored.
 *
 *  N       (input) INTEGER
 *          The order of the matrix A.  N >= 0.
 *
 *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
 *          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
-*          n by n upper triangular part of A contains the upper
+*          N-by-N upper triangular part of A contains the upper
 *          triangular part of the matrix A, and the strictly lower
 *          triangular part of A is not referenced.  If UPLO = 'L', the
-*          leading n by n lower triangular part of A contains the lower
+*          leading N-by-N lower triangular part of A contains the lower
 *          triangular part of the matrix A, and the strictly upper
 *          triangular part of A is not referenced.
 *
 *          On exit, if INFO = 0, the factor U or L from the Cholesky
-*          factorization A = U'*U or A = L*L'.
+*          factorization A = U**T*U or A = L*L**T.
 *
 *  LDA     (input) INTEGER
 *          The leading dimension of the array A.  LDA >= max(1,N).
 *
 *  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*          > 0: if INFO = k, the leading minor of order k is not
-*               positive definite, and the factorization could not be
-*               completed.
+*          = 0:  successful exit
+*          < 0:  if INFO = -i, the i-th argument had an illegal value
+*          > 0:  if INFO = i, the leading minor of order i is not
+*                positive definite, and the factorization could not be
+*                completed.
 *
 *  =====================================================================
 *
diff --git a/libcruft/lapack/drscl.f b/libcruft/lapack/drscl.f
--- a/libcruft/lapack/drscl.f
+++ b/libcruft/lapack/drscl.f
@@ -1,6 +1,6 @@
       SUBROUTINE DRSCL( N, SA, SX, INCX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
@@ -53,7 +53,7 @@
       EXTERNAL           DLAMCH
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, DSCAL
+      EXTERNAL           DSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS
diff --git a/libcruft/lapack/dsteqr.f b/libcruft/lapack/dsteqr.f
--- a/libcruft/lapack/dsteqr.f
+++ b/libcruft/lapack/dsteqr.f
@@ -1,6 +1,6 @@
       SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/dsterf.f b/libcruft/lapack/dsterf.f
--- a/libcruft/lapack/dsterf.f
+++ b/libcruft/lapack/dsterf.f
@@ -1,9 +1,9 @@
       SUBROUTINE DSTERF( N, D, E, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, N
@@ -50,11 +50,11 @@
       PARAMETER          ( MAXIT = 30 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, ISCALE, JTOT, L, L1, LEND, LENDM1, LENDP1,
-     $                   LENDSV, LM1, LSV, M, MM1, NM1, NMAXIT
+      INTEGER            I, ISCALE, JTOT, L, L1, LEND, LENDSV, LSV, M,
+     $                   NMAXIT
       DOUBLE PRECISION   ALPHA, ANORM, BB, C, EPS, EPS2, GAMMA, OLDC,
      $                   OLDGAM, P, R, RT1, RT2, RTE, S, SAFMAX, SAFMIN,
-     $                   SIGMA, SSFMAX, SSFMIN, TST
+     $                   SIGMA, SSFMAX, SSFMIN
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   DLAMCH, DLANST, DLAPY2
@@ -102,25 +102,19 @@
 *     element is smaller.
 *
       L1 = 1
-      NM1 = N - 1
 *
    10 CONTINUE
       IF( L1.GT.N )
      $   GO TO 170
       IF( L1.GT.1 )
      $   E( L1-1 ) = ZERO
-      IF( L1.LE.NM1 ) THEN
-         DO 20 M = L1, NM1
-            TST = ABS( E( M ) )
-            IF( TST.EQ.ZERO )
-     $         GO TO 30
-            IF( TST.LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
-     $          1 ) ) ) )*EPS ) THEN
-               E( M ) = ZERO
-               GO TO 30
-            END IF
-   20    CONTINUE
-      END IF
+      DO 20 M = L1, N - 1
+         IF( ABS( E( M ) ).LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
+     $       1 ) ) ) )*EPS ) THEN
+            E( M ) = ZERO
+            GO TO 30
+         END IF
+   20 CONTINUE
       M = N
 *
    30 CONTINUE
@@ -169,14 +163,11 @@
 *
    50    CONTINUE
          IF( L.NE.LEND ) THEN
-            LENDM1 = LEND - 1
-            DO 60 M = L, LENDM1
-               TST = ABS( E( M ) )
-               IF( TST.LE.EPS2*ABS( D( M )*D( M+1 ) ) )
+            DO 60 M = L, LEND - 1
+               IF( ABS( E( M ) ).LE.EPS2*ABS( D( M )*D( M+1 ) ) )
      $            GO TO 70
    60       CONTINUE
          END IF
-*
          M = LEND
 *
    70    CONTINUE
@@ -219,8 +210,7 @@
 *
 *        Inner loop
 *
-         MM1 = M - 1
-         DO 80 I = MM1, L, -1
+         DO 80 I = M - 1, L, -1
             BB = E( I )
             R = P + BB
             IF( I.NE.M-1 )
@@ -260,15 +250,10 @@
 *        Look for small superdiagonal element.
 *
   100    CONTINUE
-         IF( L.NE.LEND ) THEN
-            LENDP1 = LEND + 1
-            DO 110 M = L, LENDP1, -1
-               TST = ABS( E( M-1 ) )
-               IF( TST.LE.EPS2*ABS( D( M )*D( M-1 ) ) )
-     $            GO TO 120
-  110       CONTINUE
-         END IF
-*
+         DO 110 M = L, LEND + 1, -1
+            IF( ABS( E( M-1 ) ).LE.EPS2*ABS( D( M )*D( M-1 ) ) )
+     $         GO TO 120
+  110    CONTINUE
          M = LEND
 *
   120    CONTINUE
@@ -311,8 +296,7 @@
 *
 *        Inner loop
 *
-         LM1 = L - 1
-         DO 130 I = M, LM1
+         DO 130 I = M, L - 1
             BB = E( I )
             R = P + BB
             IF( I.NE.M )
@@ -331,7 +315,7 @@
             END IF
   130    CONTINUE
 *
-         E( LM1 ) = S*P
+         E( L-1 ) = S*P
          D( L ) = SIGMA + GAMMA
          GO TO 100
 *
@@ -360,20 +344,20 @@
 *     Check for no convergence to an eigenvalue after a total
 *     of N*MAXIT iterations.
 *
-      IF( JTOT.EQ.NMAXIT ) THEN
-         DO 160 I = 1, N - 1
-            IF( E( I ).NE.ZERO )
-     $         INFO = INFO + 1
-  160    CONTINUE
-         RETURN
-      END IF
-      GO TO 10
+      IF( JTOT.LT.NMAXIT )
+     $   GO TO 10
+      DO 160 I = 1, N - 1
+         IF( E( I ).NE.ZERO )
+     $      INFO = INFO + 1
+  160 CONTINUE
+      GO TO 180
 *
 *     Sort eigenvalues in increasing order.
 *
   170 CONTINUE
       CALL DLASRT( 'I', N, D, INFO )
 *
+  180 CONTINUE
       RETURN
 *
 *     End of DSTERF
diff --git a/libcruft/lapack/dsyev.f b/libcruft/lapack/dsyev.f
--- a/libcruft/lapack/dsyev.f
+++ b/libcruft/lapack/dsyev.f
@@ -1,9 +1,9 @@
       SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBZ, UPLO
@@ -59,6 +59,11 @@
 *          For optimal efficiency, LWORK >= (NB+2)*N,
 *          where NB is the blocksize for DSYTRD returned by ILAENV.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -73,16 +78,17 @@
       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            LOWER, WANTZ
+      LOGICAL            LOWER, LQUERY, WANTZ
       INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
-     $                   LLWORK, LOPT
+     $                   LLWORK, LOPT, LWKOPT, NB
       DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
      $                   SMLNUM
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
+      INTEGER            ILAENV
       DOUBLE PRECISION   DLAMCH, DLANSY
-      EXTERNAL           LSAME, DLAMCH, DLANSY
+      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANSY
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF, DSYTRD,
@@ -97,6 +103,7 @@
 *
       WANTZ = LSAME( JOBZ, 'V' )
       LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
       INFO = 0
       IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
@@ -107,13 +114,21 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, 3*N-1 ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 3*N-1 ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
 *
+      IF( INFO.EQ.0 ) THEN
+         NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
+         LWKOPT = MAX( 1, ( NB+2 )*N )
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DSYEV ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -189,7 +204,7 @@
 *
 *     Set WORK(1) to optimal workspace size.
 *
-      WORK( 1 ) = MAX( 3*N-1, LOPT )
+      WORK( 1 ) = LWKOPT
 *
       RETURN
 *
diff --git a/libcruft/lapack/dsytd2.f b/libcruft/lapack/dsytd2.f
--- a/libcruft/lapack/dsytd2.f
+++ b/libcruft/lapack/dsytd2.f
@@ -1,6 +1,6 @@
       SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/dsytrd.f b/libcruft/lapack/dsytrd.f
--- a/libcruft/lapack/dsytrd.f
+++ b/libcruft/lapack/dsytrd.f
@@ -1,9 +1,9 @@
       SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
@@ -73,6 +73,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -124,11 +129,12 @@
 *
 *     .. Parameters ..
       DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
+      PARAMETER          ( ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            I, IINFO, IWS, J, KK, LDWORK, NB, NBMIN, NX
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
+     $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DLATRD, DSYR2K, DSYTD2, XERBLA
@@ -147,18 +153,31 @@
 *
       INFO = 0
       UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.1 ) THEN
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
          INFO = -9
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size.
+*
+         NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DSYTRD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -168,9 +187,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
       NX = N
       IWS = 1
       IF( NB.GT.1 .AND. NB.LT.N ) THEN
@@ -271,7 +287,7 @@
      $                TAU( I ), IINFO )
       END IF
 *
-      WORK( 1 ) = IWS
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of DSYTRD
diff --git a/libcruft/lapack/dtgevc.f b/libcruft/lapack/dtgevc.f
--- a/libcruft/lapack/dtgevc.f
+++ b/libcruft/lapack/dtgevc.f
@@ -1,10 +1,10 @@
       SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
      $                   LDVL, VR, LDVR, MM, M, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          HOWMNY, SIDE
@@ -112,7 +112,7 @@
 *          The leading dimension of array VL.
 *          LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
 *
-*  VR      (input/output) COMPLEX*16 array, dimension (LDVR,MM)
+*  VR      (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
 *          On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
 *          contain an N-by-N matrix Q (usually the orthogonal matrix Z
 *          of right Schur vectors returned by DHGEQZ).
@@ -235,7 +235,7 @@
       EXTERNAL           LSAME, DLAMCH
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEMV, DLABAD, DLACPY, DLAG2, DLALN2, XERBLA
+      EXTERNAL           DGEMV, DLACPY, DLAG2, DLALN2, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, MAX, MIN
@@ -277,6 +277,23 @@
          ISIDE = -1
       END IF
 *
+      INFO = 0
+      IF( ISIDE.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( IHWMNY.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -8
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DTGEVC', -INFO )
+         RETURN
+      END IF
+*
 *     Count the number of eigenvectors to be computed
 *
       IF( .NOT.ILALL ) THEN
@@ -318,21 +335,10 @@
          END IF
    20 CONTINUE
 *
-      INFO = 0
-      IF( ISIDE.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( IHWMNY.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( ILABAD ) THEN
+      IF( ILABAD ) THEN
          INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -6
       ELSE IF( ILBBAD ) THEN
          INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -8
       ELSE IF( COMPL .AND. LDVL.LT.N .OR. LDVL.LT.1 ) THEN
          INFO = -10
       ELSE IF( COMPR .AND. LDVR.LT.N .OR. LDVR.LT.1 ) THEN
diff --git a/libcruft/lapack/dtrevc.f b/libcruft/lapack/dtrevc.f
--- a/libcruft/lapack/dtrevc.f
+++ b/libcruft/lapack/dtrevc.f
@@ -1,10 +1,10 @@
       SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
      $                   LDVR, MM, M, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          HOWMNY, SIDE
@@ -44,7 +44,6 @@
 *  eigenvectors; only one eigenvector of the pair is computed, namely
 *  the one corresponding to the eigenvalue with positive imaginary part.
 *
-*
 *  Arguments
 *  =========
 *
@@ -87,6 +86,15 @@
 *          of Schur vectors returned by DHSEQR).
 *          On exit, if SIDE = 'L' or 'B', VL contains:
 *          if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+*                           VL has the same quasi-lower triangular form
+*                           as T'. If T(i,i) is a real eigenvalue, then
+*                           the i-th column VL(i) of VL  is its
+*                           corresponding eigenvector. If T(i:i+1,i:i+1)
+*                           is a 2-by-2 block whose eigenvalues are
+*                           complex-conjugate eigenvalues of T, then
+*                           VL(i)+sqrt(-1)*VL(i+1) is the complex
+*                           eigenvector corresponding to the eigenvalue
+*                           with positive real part.
 *          if HOWMNY = 'B', the matrix Q*Y;
 *          if HOWMNY = 'S', the left eigenvectors of T specified by
 *                           SELECT, stored consecutively in the columns
@@ -107,6 +115,15 @@
 *          of Schur vectors returned by DHSEQR).
 *          On exit, if SIDE = 'R' or 'B', VR contains:
 *          if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+*                           VR has the same quasi-upper triangular form
+*                           as T. If T(i,i) is a real eigenvalue, then
+*                           the i-th column VR(i) of VR  is its
+*                           corresponding eigenvector. If T(i:i+1,i:i+1)
+*                           is a 2-by-2 block whose eigenvalues are
+*                           complex-conjugate eigenvalues of T, then
+*                           VR(i)+sqrt(-1)*VR(i+1) is the complex
+*                           eigenvector corresponding to the eigenvalue
+*                           with positive real part.
 *          if HOWMNY = 'B', the matrix Q*X;
 *          if HOWMNY = 'S', the right eigenvectors of T specified by
 *                           SELECT, stored consecutively in the columns
@@ -168,8 +185,7 @@
       EXTERNAL           LSAME, IDAMAX, DDOT, DLAMCH
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMV, DLABAD, DLALN2, DSCAL,
-     $                   XERBLA
+      EXTERNAL           DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, MAX, SQRT
@@ -186,7 +202,7 @@
       LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
 *
       ALLV = LSAME( HOWMNY, 'A' )
-      OVER = LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'O' )
+      OVER = LSAME( HOWMNY, 'B' )
       SOMEV = LSAME( HOWMNY, 'S' )
 *
       INFO = 0
diff --git a/libcruft/lapack/dtrexc.f b/libcruft/lapack/dtrexc.f
--- a/libcruft/lapack/dtrexc.f
+++ b/libcruft/lapack/dtrexc.f
@@ -1,7 +1,7 @@
       SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
      $                   INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
diff --git a/libcruft/lapack/dtrsen.f b/libcruft/lapack/dtrsen.f
--- a/libcruft/lapack/dtrsen.f
+++ b/libcruft/lapack/dtrsen.f
@@ -1,10 +1,10 @@
       SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI,
      $                   M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          COMPQ, JOB
@@ -112,7 +112,8 @@
 *          M = 0 or N, SEP = norm(T).
 *          If JOB = 'N' or 'E', SEP is not referenced.
 *
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (LWORK)
+*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *
 *  LWORK   (input) INTEGER
 *          The dimension of the array WORK.
@@ -120,6 +121,11 @@
 *          if JOB = 'E', LWORK >= M*(N-M);
 *          if JOB = 'V' or 'B', LWORK >= 2*M*(N-M).
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  IWORK   (workspace) INTEGER array, dimension (LIWORK)
 *          IF JOB = 'N' or 'E', IWORK is not referenced.
 *
@@ -128,6 +134,11 @@
 *          If JOB = 'N' or 'E', LIWORK >= 1;
 *          if JOB = 'V' or 'B', LIWORK >= M*(N-M).
 *
+*          If LIWORK = -1, then a workspace query is assumed; the
+*          routine only calculates the optimal size of the IWORK array,
+*          returns this value as the first entry of the IWORK array, and
+*          no error message related to LIWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0: successful exit
 *          < 0: if INFO = -i, the i-th argument had an illegal value
@@ -216,8 +227,10 @@
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            PAIR, SWAP, WANTBH, WANTQ, WANTS, WANTSP
-      INTEGER            IERR, K, KASE, KK, KS, N1, N2, NN
+      LOGICAL            LQUERY, PAIR, SWAP, WANTBH, WANTQ, WANTS,
+     $                   WANTSP
+      INTEGER            IERR, K, KASE, KK, KS, LIWMIN, LWMIN, N1, N2,
+     $                   NN
       DOUBLE PRECISION   EST, RNORM, SCALE
 *     ..
 *     .. External Functions ..
@@ -241,6 +254,7 @@
       WANTQ = LSAME( COMPQ, 'V' )
 *
       INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.WANTS .AND. .NOT.WANTSP )
      $     THEN
          INFO = -1
@@ -283,16 +297,34 @@
          N2 = N - M
          NN = N1*N2
 *
-         IF( LWORK.LT.1 .OR. ( ( WANTS .AND. .NOT.WANTSP ) .AND.
-     $       LWORK.LT.NN ) .OR. ( WANTSP .AND. LWORK.LT.2*NN ) ) THEN
+         IF( WANTSP ) THEN
+            LWMIN = MAX( 1, 2*NN )
+            LIWMIN = MAX( 1, NN )
+         ELSE IF( LSAME( JOB, 'N' ) ) THEN
+            LWMIN = MAX( 1, N )
+            LIWMIN = 1
+         ELSE IF( LSAME( JOB, 'E' ) ) THEN
+            LWMIN = MAX( 1, NN )
+            LIWMIN = 1
+         END IF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
             INFO = -15
-         ELSE IF( LIWORK.LT.1 .OR. ( WANTSP .AND. LIWORK.LT.NN ) ) THEN
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
             INFO = -17
          END IF
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 ) = LWMIN
+         IWORK( 1 ) = LIWMIN
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'DTRSEN', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible.
@@ -414,6 +446,10 @@
             WI( K+1 ) = -WI( K )
          END IF
    60 CONTINUE
+*
+      WORK( 1 ) = LWMIN
+      IWORK( 1 ) = LIWMIN
+*
       RETURN
 *
 *     End of DTRSEN
diff --git a/libcruft/lapack/dtrsyl.f b/libcruft/lapack/dtrsyl.f
--- a/libcruft/lapack/dtrsyl.f
+++ b/libcruft/lapack/dtrsyl.f
@@ -1,7 +1,7 @@
       SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
      $                   LDC, SCALE, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
@@ -111,7 +111,7 @@
       EXTERNAL           LSAME, DDOT, DLAMCH, DLANGE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, DLALN2, DLASY2, DSCAL, XERBLA
+      EXTERNAL           DLALN2, DLASY2, DSCAL, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, MAX, MIN
diff --git a/libcruft/lapack/dzsum1.f b/libcruft/lapack/dzsum1.f
--- a/libcruft/lapack/dzsum1.f
+++ b/libcruft/lapack/dzsum1.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION DZSUM1( N, CX, INCX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/ieeeck.f b/libcruft/lapack/ieeeck.f
new file mode 100644
--- /dev/null
+++ b/libcruft/lapack/ieeeck.f
@@ -0,0 +1,148 @@
+      INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
+*
+*  -- LAPACK auxiliary routine (version 3.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+*     Courant Institute, Argonne National Lab, and Rice University
+*     June 30, 1998
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISPEC
+      REAL               ONE, ZERO
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  IEEECK is called from the ILAENV to verify that Infinity and
+*  possibly NaN arithmetic is safe (i.e. will not trap).
+*
+*  Arguments
+*  =========
+*
+*  ISPEC   (input) INTEGER
+*          Specifies whether to test just for inifinity arithmetic
+*          or whether to test for infinity and NaN arithmetic.
+*          = 0: Verify infinity arithmetic only.
+*          = 1: Verify infinity and NaN arithmetic.
+*
+*  ZERO    (input) REAL
+*          Must contain the value 0.0
+*          This is passed to prevent the compiler from optimizing
+*          away this code.
+*
+*  ONE     (input) REAL
+*          Must contain the value 1.0
+*          This is passed to prevent the compiler from optimizing
+*          away this code.
+*
+*  RETURN VALUE:  INTEGER
+*          = 0:  Arithmetic failed to produce the correct answers
+*          = 1:  Arithmetic produced the correct answers
+*
+*     .. Local Scalars ..
+      REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
+     $                   NEGZRO, NEWZRO, POSINF
+*     ..
+*     .. Executable Statements ..
+      IEEECK = 1
+*
+      POSINF = ONE / ZERO
+      IF( POSINF.LE.ONE ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      NEGINF = -ONE / ZERO
+      IF( NEGINF.GE.ZERO ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      NEGZRO = ONE / ( NEGINF+ONE )
+      IF( NEGZRO.NE.ZERO ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      NEGINF = ONE / NEGZRO
+      IF( NEGINF.GE.ZERO ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      NEWZRO = NEGZRO + ZERO
+      IF( NEWZRO.NE.ZERO ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      POSINF = ONE / NEWZRO
+      IF( POSINF.LE.ONE ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      NEGINF = NEGINF*POSINF
+      IF( NEGINF.GE.ZERO ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      POSINF = POSINF*POSINF
+      IF( POSINF.LE.ONE ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+*
+*
+*
+*     Return if we were only asked to check infinity arithmetic
+*
+      IF( ISPEC.EQ.0 )
+     $   RETURN
+*
+      NAN1 = POSINF + NEGINF
+*
+      NAN2 = POSINF / NEGINF
+*
+      NAN3 = POSINF / POSINF
+*
+      NAN4 = POSINF*ZERO
+*
+      NAN5 = NEGINF*NEGZRO
+*
+      NAN6 = NAN5*0.0
+*
+      IF( NAN1.EQ.NAN1 ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      IF( NAN2.EQ.NAN2 ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      IF( NAN3.EQ.NAN3 ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      IF( NAN4.EQ.NAN4 ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      IF( NAN5.EQ.NAN5 ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      IF( NAN6.EQ.NAN6 ) THEN
+         IEEECK = 0
+         RETURN
+      END IF
+*
+      RETURN
+      END
diff --git a/libcruft/lapack/ilaenv.f b/libcruft/lapack/ilaenv.f
--- a/libcruft/lapack/ilaenv.f
+++ b/libcruft/lapack/ilaenv.f
@@ -1,10 +1,10 @@
       INTEGER          FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
      $                 N4 )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER*( * )    NAME, OPTS
@@ -52,6 +52,11 @@
 *          = 7: the number of processors
 *          = 8: the crossover point for the multishift QR and QZ methods
 *               for nonsymmetric eigenvalue problems.
+*          = 9: maximum size of the subproblems at the bottom of the
+*               computation tree in the divide-and-conquer algorithm
+*               (used by xGELSD and xGESDD)
+*          =10: ieee NaN arithmetic can be trusted not to trap
+*          =11: infinity arithmetic can be trusted not to trap
 *
 *  NAME    (input) CHARACTER*(*)
 *          The name of the calling subroutine, in either upper case or
@@ -107,9 +112,14 @@
 *     .. Intrinsic Functions ..
       INTRINSIC          CHAR, ICHAR, INT, MIN, REAL
 *     ..
+*     .. External Functions ..
+      INTEGER            IEEECK
+      EXTERNAL           IEEECK
+*     ..
 *     .. Executable Statements ..
 *
-      GO TO ( 100, 100, 100, 400, 500, 600, 700, 800 ) ISPEC
+      GO TO ( 100, 100, 100, 400, 500, 600, 700, 800, 900, 1000,
+     $        1100 ) ISPEC
 *
 *     Invalid value for ISPEC
 *
@@ -238,7 +248,7 @@
                NB = 64
             END IF
          ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
-            NB = 1
+            NB = 32
          ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
             NB = 64
          END IF
@@ -246,7 +256,7 @@
          IF( C3.EQ.'TRF' ) THEN
             NB = 64
          ELSE IF( C3.EQ.'TRD' ) THEN
-            NB = 1
+            NB = 32
          ELSE IF( C3.EQ.'GST' ) THEN
             NB = 64
          END IF
@@ -440,11 +450,11 @@
          END IF
       ELSE IF( C2.EQ.'SY' ) THEN
          IF( SNAME .AND. C3.EQ.'TRD' ) THEN
-            NX = 1
+            NX = 32
          END IF
       ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
          IF( C3.EQ.'TRD' ) THEN
-            NX = 1
+            NX = 32
          END IF
       ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
          IF( C3( 1:1 ).EQ.'G' ) THEN
@@ -501,6 +511,37 @@
       ILAENV = 50
       RETURN
 *
+  900 CONTINUE
+*
+*     ISPEC = 9:  maximum size of the subproblems at the bottom of the
+*                 computation tree in the divide-and-conquer algorithm
+*                 (used by xGELSD and xGESDD)
+*
+      ILAENV = 25
+      RETURN
+*
+ 1000 CONTINUE
+*
+*     ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
+*
+C     ILAENV = 0
+      ILAENV = 1
+      IF( ILAENV.EQ.1 ) THEN
+         ILAENV = IEEECK( 0, 0.0, 1.0 ) 
+      END IF
+      RETURN
+*
+ 1100 CONTINUE
+*
+*     ISPEC = 11: infinity arithmetic can be trusted not to trap
+*
+C     ILAENV = 0
+      ILAENV = 1
+      IF( ILAENV.EQ.1 ) THEN
+         ILAENV = IEEECK( 1, 0.0, 1.0 ) 
+      END IF
+      RETURN
+*
 *     End of ILAENV
 *
       END
diff --git a/libcruft/lapack/izmax1.f b/libcruft/lapack/izmax1.f
--- a/libcruft/lapack/izmax1.f
+++ b/libcruft/lapack/izmax1.f
@@ -1,9 +1,9 @@
       INTEGER          FUNCTION IZMAX1( N, CX, INCX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INCX, N
@@ -51,7 +51,7 @@
 *     .. Statement Function definitions ..
 *
 *     NEXT LINE IS THE ONLY MODIFICATION.
-      CABS1( ZDUM ) = ABS( DBLE( ZDUM ) )
+      CABS1( ZDUM ) = ABS( ZDUM )
 *     ..
 *     .. Executable Statements ..
 *
diff --git a/libcruft/lapack/zbdsqr.f b/libcruft/lapack/zbdsqr.f
--- a/libcruft/lapack/zbdsqr.f
+++ b/libcruft/lapack/zbdsqr.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
      $                   LDU, C, LDC, RWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
@@ -152,9 +152,9 @@
       PARAMETER          ( MAXITR = 6 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            ROTATE
-      INTEGER            I, IDIR, IROT, ISUB, ITER, IUPLO, J, LL, LLL,
-     $                   M, MAXIT, NM1, NM12, NM13, OLDLL, OLDM
+      LOGICAL            LOWER, ROTATE
+      INTEGER            I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
+     $                   NM12, NM13, OLDLL, OLDM
       DOUBLE PRECISION   ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
      $                   OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
      $                   SINR, SLL, SMAX, SMIN, SMINL, SMINLO, SMINOA,
@@ -177,12 +177,8 @@
 *     Test the input parameters.
 *
       INFO = 0
-      IUPLO = 0
-      IF( LSAME( UPLO, 'U' ) )
-     $   IUPLO = 1
-      IF( LSAME( UPLO, 'L' ) )
-     $   IUPLO = 2
-      IF( IUPLO.EQ.0 ) THEN
+      LOWER = LSAME( UPLO, 'L' )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
@@ -208,7 +204,7 @@
       IF( N.EQ.0 )
      $   RETURN
       IF( N.EQ.1 )
-     $   GO TO 150
+     $   GO TO 160
 *
 *     ROTATE is true if any singular vectors desired, false otherwise
 *
@@ -224,6 +220,7 @@
       NM1 = N - 1
       NM12 = NM1 + NM1
       NM13 = NM12 + NM1
+      IDIR = 0
 *
 *     Get machine constants
 *
@@ -233,7 +230,7 @@
 *     If matrix lower bidiagonal, rotate to be upper bidiagonal
 *     by applying Givens rotations on the left
 *
-      IF( IUPLO.EQ.2 ) THEN
+      IF( LOWER ) THEN
          DO 10 I = 1, N - 1
             CALL DLARTG( D( I ), E( I ), CS, SN, R )
             D( I ) = R
@@ -262,10 +259,13 @@
 *
 *     Compute approximate maximum, minimum singular values
 *
-      SMAX = ABS( D( N ) )
-      DO 20 I = 1, N - 1
-         SMAX = MAX( SMAX, ABS( D( I ) ), ABS( E( I ) ) )
+      SMAX = ZERO
+      DO 20 I = 1, N
+         SMAX = MAX( SMAX, ABS( D( I ) ) )
    20 CONTINUE
+      DO 30 I = 1, N - 1
+         SMAX = MAX( SMAX, ABS( E( I ) ) )
+   30 CONTINUE
       SMINL = ZERO
       IF( TOL.GE.ZERO ) THEN
 *
@@ -273,15 +273,15 @@
 *
          SMINOA = ABS( D( 1 ) )
          IF( SMINOA.EQ.ZERO )
-     $      GO TO 40
+     $      GO TO 50
          MU = SMINOA
-         DO 30 I = 2, N
+         DO 40 I = 2, N
             MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
             SMINOA = MIN( SMINOA, MU )
             IF( SMINOA.EQ.ZERO )
-     $         GO TO 40
-   30    CONTINUE
+     $         GO TO 50
    40    CONTINUE
+   50    CONTINUE
          SMINOA = SMINOA / SQRT( DBLE( N ) )
          THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
       ELSE
@@ -306,14 +306,14 @@
 *
 *     Begin main iteration loop
 *
-   50 CONTINUE
+   60 CONTINUE
 *
 *     Check for convergence or exceeding iteration count
 *
       IF( M.LE.1 )
-     $   GO TO 150
+     $   GO TO 160
       IF( ITER.GT.MAXIT )
-     $   GO TO 190
+     $   GO TO 200
 *
 *     Find diagonal block of matrix to work on
 *
@@ -321,20 +321,20 @@
      $   D( M ) = ZERO
       SMAX = ABS( D( M ) )
       SMIN = SMAX
-      DO 60 LLL = 1, M
+      DO 70 LLL = 1, M - 1
          LL = M - LLL
-         IF( LL.EQ.0 )
-     $      GO TO 80
          ABSS = ABS( D( LL ) )
          ABSE = ABS( E( LL ) )
          IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
      $      D( LL ) = ZERO
          IF( ABSE.LE.THRESH )
-     $      GO TO 70
+     $      GO TO 80
          SMIN = MIN( SMIN, ABSS )
          SMAX = MAX( SMAX, ABSS, ABSE )
-   60 CONTINUE
    70 CONTINUE
+      LL = 0
+      GO TO 90
+   80 CONTINUE
       E( LL ) = ZERO
 *
 *     Matrix splits since E(LL) = 0
@@ -344,9 +344,9 @@
 *        Convergence of bottom singular value, return to top of loop
 *
          M = M - 1
-         GO TO 50
+         GO TO 60
       END IF
-   80 CONTINUE
+   90 CONTINUE
       LL = LL + 1
 *
 *     E(LL) through E(M-1) are nonzero, E(LL-1) is zero
@@ -372,7 +372,7 @@
      $      CALL ZDROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
      $                  SINL )
          M = M - 2
-         GO TO 50
+         GO TO 60
       END IF
 *
 *     If working on new submatrix, choose shift direction
@@ -402,7 +402,7 @@
          IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
      $       ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
             E( M-1 ) = ZERO
-            GO TO 50
+            GO TO 60
          END IF
 *
          IF( TOL.GE.ZERO ) THEN
@@ -412,15 +412,15 @@
 *
             MU = ABS( D( LL ) )
             SMINL = MU
-            DO 90 LLL = LL, M - 1
+            DO 100 LLL = LL, M - 1
                IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
                   E( LLL ) = ZERO
-                  GO TO 50
+                  GO TO 60
                END IF
                SMINLO = SMINL
                MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
                SMINL = MIN( SMINL, MU )
-   90       CONTINUE
+  100       CONTINUE
          END IF
 *
       ELSE
@@ -431,7 +431,7 @@
          IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
      $       ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
             E( LL ) = ZERO
-            GO TO 50
+            GO TO 60
          END IF
 *
          IF( TOL.GE.ZERO ) THEN
@@ -441,15 +441,15 @@
 *
             MU = ABS( D( M ) )
             SMINL = MU
-            DO 100 LLL = M - 1, LL, -1
+            DO 110 LLL = M - 1, LL, -1
                IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
                   E( LLL ) = ZERO
-                  GO TO 50
+                  GO TO 60
                END IF
                SMINLO = SMINL
                MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
                SMINL = MIN( SMINL, MU )
-  100       CONTINUE
+  110       CONTINUE
          END IF
       END IF
       OLDLL = LL
@@ -498,23 +498,16 @@
 *
             CS = ONE
             OLDCS = ONE
-            CALL DLARTG( D( LL )*CS, E( LL ), CS, SN, R )
-            CALL DLARTG( OLDCS*R, D( LL+1 )*SN, OLDCS, OLDSN, D( LL ) )
-            RWORK( 1 ) = CS
-            RWORK( 1+NM1 ) = SN
-            RWORK( 1+NM12 ) = OLDCS
-            RWORK( 1+NM13 ) = OLDSN
-            IROT = 1
-            DO 110 I = LL + 1, M - 1
+            DO 120 I = LL, M - 1
                CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
-               E( I-1 ) = OLDSN*R
+               IF( I.GT.LL )
+     $            E( I-1 ) = OLDSN*R
                CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
-               IROT = IROT + 1
-               RWORK( IROT ) = CS
-               RWORK( IROT+NM1 ) = SN
-               RWORK( IROT+NM12 ) = OLDCS
-               RWORK( IROT+NM13 ) = OLDSN
-  110       CONTINUE
+               RWORK( I-LL+1 ) = CS
+               RWORK( I-LL+1+NM1 ) = SN
+               RWORK( I-LL+1+NM12 ) = OLDCS
+               RWORK( I-LL+1+NM13 ) = OLDSN
+  120       CONTINUE
             H = D( M )*CS
             D( M ) = H*OLDCS
             E( M-1 ) = H*OLDSN
@@ -543,23 +536,16 @@
 *
             CS = ONE
             OLDCS = ONE
-            CALL DLARTG( D( M )*CS, E( M-1 ), CS, SN, R )
-            CALL DLARTG( OLDCS*R, D( M-1 )*SN, OLDCS, OLDSN, D( M ) )
-            RWORK( M-LL ) = CS
-            RWORK( M-LL+NM1 ) = -SN
-            RWORK( M-LL+NM12 ) = OLDCS
-            RWORK( M-LL+NM13 ) = -OLDSN
-            IROT = M - LL
-            DO 120 I = M - 1, LL + 1, -1
+            DO 130 I = M, LL + 1, -1
                CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
-               E( I ) = OLDSN*R
+               IF( I.LT.M )
+     $            E( I ) = OLDSN*R
                CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
-               IROT = IROT - 1
-               RWORK( IROT ) = CS
-               RWORK( IROT+NM1 ) = -SN
-               RWORK( IROT+NM12 ) = OLDCS
-               RWORK( IROT+NM13 ) = -OLDSN
-  120       CONTINUE
+               RWORK( I-LL ) = CS
+               RWORK( I-LL+NM1 ) = -SN
+               RWORK( I-LL+NM12 ) = OLDCS
+               RWORK( I-LL+NM13 ) = -OLDSN
+  130       CONTINUE
             H = D( LL )*CS
             D( LL ) = H*OLDCS
             E( LL ) = H*OLDSN
@@ -593,25 +579,10 @@
             F = ( ABS( D( LL ) )-SHIFT )*
      $          ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
             G = E( LL )
-            CALL DLARTG( F, G, COSR, SINR, R )
-            F = COSR*D( LL ) + SINR*E( LL )
-            E( LL ) = COSR*E( LL ) - SINR*D( LL )
-            G = SINR*D( LL+1 )
-            D( LL+1 ) = COSR*D( LL+1 )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( LL ) = R
-            F = COSL*E( LL ) + SINL*D( LL+1 )
-            D( LL+1 ) = COSL*D( LL+1 ) - SINL*E( LL )
-            G = SINL*E( LL+1 )
-            E( LL+1 ) = COSL*E( LL+1 )
-            RWORK( 1 ) = COSR
-            RWORK( 1+NM1 ) = SINR
-            RWORK( 1+NM12 ) = COSL
-            RWORK( 1+NM13 ) = SINL
-            IROT = 1
-            DO 130 I = LL + 1, M - 2
+            DO 140 I = LL, M - 1
                CALL DLARTG( F, G, COSR, SINR, R )
-               E( I-1 ) = R
+               IF( I.GT.LL )
+     $            E( I-1 ) = R
                F = COSR*D( I ) + SINR*E( I )
                E( I ) = COSR*E( I ) - SINR*D( I )
                G = SINR*D( I+1 )
@@ -620,29 +591,15 @@
                D( I ) = R
                F = COSL*E( I ) + SINL*D( I+1 )
                D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
-               G = SINL*E( I+1 )
-               E( I+1 ) = COSL*E( I+1 )
-               IROT = IROT + 1
-               RWORK( IROT ) = COSR
-               RWORK( IROT+NM1 ) = SINR
-               RWORK( IROT+NM12 ) = COSL
-               RWORK( IROT+NM13 ) = SINL
-  130       CONTINUE
-            CALL DLARTG( F, G, COSR, SINR, R )
-            E( M-2 ) = R
-            F = COSR*D( M-1 ) + SINR*E( M-1 )
-            E( M-1 ) = COSR*E( M-1 ) - SINR*D( M-1 )
-            G = SINR*D( M )
-            D( M ) = COSR*D( M )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( M-1 ) = R
-            F = COSL*E( M-1 ) + SINL*D( M )
-            D( M ) = COSL*D( M ) - SINL*E( M-1 )
-            IROT = IROT + 1
-            RWORK( IROT ) = COSR
-            RWORK( IROT+NM1 ) = SINR
-            RWORK( IROT+NM12 ) = COSL
-            RWORK( IROT+NM13 ) = SINL
+               IF( I.LT.M-1 ) THEN
+                  G = SINL*E( I+1 )
+                  E( I+1 ) = COSL*E( I+1 )
+               END IF
+               RWORK( I-LL+1 ) = COSR
+               RWORK( I-LL+1+NM1 ) = SINR
+               RWORK( I-LL+1+NM12 ) = COSL
+               RWORK( I-LL+1+NM13 ) = SINL
+  140       CONTINUE
             E( M-1 ) = F
 *
 *           Update singular vectors
@@ -670,25 +627,10 @@
             F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
      $          D( M ) )
             G = E( M-1 )
-            CALL DLARTG( F, G, COSR, SINR, R )
-            F = COSR*D( M ) + SINR*E( M-1 )
-            E( M-1 ) = COSR*E( M-1 ) - SINR*D( M )
-            G = SINR*D( M-1 )
-            D( M-1 ) = COSR*D( M-1 )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( M ) = R
-            F = COSL*E( M-1 ) + SINL*D( M-1 )
-            D( M-1 ) = COSL*D( M-1 ) - SINL*E( M-1 )
-            G = SINL*E( M-2 )
-            E( M-2 ) = COSL*E( M-2 )
-            RWORK( M-LL ) = COSR
-            RWORK( M-LL+NM1 ) = -SINR
-            RWORK( M-LL+NM12 ) = COSL
-            RWORK( M-LL+NM13 ) = -SINL
-            IROT = M - LL
-            DO 140 I = M - 1, LL + 2, -1
+            DO 150 I = M, LL + 1, -1
                CALL DLARTG( F, G, COSR, SINR, R )
-               E( I ) = R
+               IF( I.LT.M )
+     $            E( I ) = R
                F = COSR*D( I ) + SINR*E( I-1 )
                E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
                G = SINR*D( I-1 )
@@ -697,29 +639,15 @@
                D( I ) = R
                F = COSL*E( I-1 ) + SINL*D( I-1 )
                D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
-               G = SINL*E( I-2 )
-               E( I-2 ) = COSL*E( I-2 )
-               IROT = IROT - 1
-               RWORK( IROT ) = COSR
-               RWORK( IROT+NM1 ) = -SINR
-               RWORK( IROT+NM12 ) = COSL
-               RWORK( IROT+NM13 ) = -SINL
-  140       CONTINUE
-            CALL DLARTG( F, G, COSR, SINR, R )
-            E( LL+1 ) = R
-            F = COSR*D( LL+1 ) + SINR*E( LL )
-            E( LL ) = COSR*E( LL ) - SINR*D( LL+1 )
-            G = SINR*D( LL )
-            D( LL ) = COSR*D( LL )
-            CALL DLARTG( F, G, COSL, SINL, R )
-            D( LL+1 ) = R
-            F = COSL*E( LL ) + SINL*D( LL )
-            D( LL ) = COSL*D( LL ) - SINL*E( LL )
-            IROT = IROT - 1
-            RWORK( IROT ) = COSR
-            RWORK( IROT+NM1 ) = -SINR
-            RWORK( IROT+NM12 ) = COSL
-            RWORK( IROT+NM13 ) = -SINL
+               IF( I.GT.LL+1 ) THEN
+                  G = SINL*E( I-2 )
+                  E( I-2 ) = COSL*E( I-2 )
+               END IF
+               RWORK( I-LL ) = COSR
+               RWORK( I-LL+NM1 ) = -SINR
+               RWORK( I-LL+NM12 ) = COSL
+               RWORK( I-LL+NM13 ) = -SINL
+  150       CONTINUE
             E( LL ) = F
 *
 *           Test convergence
@@ -743,12 +671,12 @@
 *
 *     QR iteration finished, go back and check convergence
 *
-      GO TO 50
+      GO TO 60
 *
 *     All singular values converged, so make them positive
 *
-  150 CONTINUE
-      DO 160 I = 1, N
+  160 CONTINUE
+      DO 170 I = 1, N
          IF( D( I ).LT.ZERO ) THEN
             D( I ) = -D( I )
 *
@@ -757,23 +685,23 @@
             IF( NCVT.GT.0 )
      $         CALL ZDSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
          END IF
-  160 CONTINUE
+  170 CONTINUE
 *
 *     Sort the singular values into decreasing order (insertion sort on
 *     singular values, but only one transposition per singular vector)
 *
-      DO 180 I = 1, N - 1
+      DO 190 I = 1, N - 1
 *
 *        Scan for smallest D(I)
 *
          ISUB = 1
          SMIN = D( 1 )
-         DO 170 J = 2, N + 1 - I
+         DO 180 J = 2, N + 1 - I
             IF( D( J ).LE.SMIN ) THEN
                ISUB = J
                SMIN = D( J )
             END IF
-  170    CONTINUE
+  180    CONTINUE
          IF( ISUB.NE.N+1-I ) THEN
 *
 *           Swap singular values and vectors
@@ -788,18 +716,18 @@
             IF( NCC.GT.0 )
      $         CALL ZSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
          END IF
-  180 CONTINUE
-      GO TO 210
+  190 CONTINUE
+      GO TO 220
 *
 *     Maximum number of iterations exceeded, failure to converge
 *
-  190 CONTINUE
+  200 CONTINUE
       INFO = 0
-      DO 200 I = 1, N - 1
+      DO 210 I = 1, N - 1
          IF( E( I ).NE.ZERO )
      $      INFO = INFO + 1
-  200 CONTINUE
   210 CONTINUE
+  220 CONTINUE
       RETURN
 *
 *     End of ZBDSQR
diff --git a/libcruft/lapack/zdrscl.f b/libcruft/lapack/zdrscl.f
--- a/libcruft/lapack/zdrscl.f
+++ b/libcruft/lapack/zdrscl.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZDRSCL( N, SA, SX, INCX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgebak.f b/libcruft/lapack/zgebak.f
--- a/libcruft/lapack/zgebak.f
+++ b/libcruft/lapack/zgebak.f
@@ -1,7 +1,7 @@
       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
      $                   INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgebal.f b/libcruft/lapack/zgebal.f
--- a/libcruft/lapack/zgebal.f
+++ b/libcruft/lapack/zgebal.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOB
@@ -97,13 +97,16 @@
 *
 *  This subroutine is based on the EISPACK routine CBAL.
 *
+*  Modified by Tzu-Yi Chen, Computer Science Division, University of
+*    California at Berkeley, USA
+*
 *  =====================================================================
 *
 *     .. Parameters ..
       DOUBLE PRECISION   ZERO, ONE
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
       DOUBLE PRECISION   SCLFAC
-      PARAMETER          ( SCLFAC = 1.0D+1 )
+      PARAMETER          ( SCLFAC = 0.8D+1 )
       DOUBLE PRECISION   FACTOR
       PARAMETER          ( FACTOR = 0.95D+0 )
 *     ..
diff --git a/libcruft/lapack/zgebd2.f b/libcruft/lapack/zgebd2.f
--- a/libcruft/lapack/zgebd2.f
+++ b/libcruft/lapack/zgebd2.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgebrd.f b/libcruft/lapack/zgebrd.f
--- a/libcruft/lapack/zgebrd.f
+++ b/libcruft/lapack/zgebrd.f
@@ -1,18 +1,17 @@
       SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
      $                   INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
       DOUBLE PRECISION   D( * ), E( * )
-      COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ),
-     $                   WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -79,6 +78,11 @@
 *          For optimum performance LWORK >= (M+N)*NB, where NB
 *          is the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit.
 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
@@ -137,15 +141,16 @@
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, MINMN, NB, NBMIN,
-     $                   NX
+      LOGICAL            LQUERY
+      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
+     $                   NBMIN, NX
       DOUBLE PRECISION   WS
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZGEBD2, ZGEMM, ZLABRD
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
+      INTRINSIC          DBLE, MAX, MIN
 *     ..
 *     .. External Functions ..
       INTEGER            ILAENV
@@ -156,18 +161,24 @@
 *     Test the input parameters
 *
       INFO = 0
+      NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) )
+      LWKOPT = ( M+N )*NB
+      WORK( 1 ) = DBLE( LWKOPT )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.LT.0 ) THEN
          CALL XERBLA( 'ZGEBRD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -182,15 +193,14 @@
       LDWRKX = M
       LDWRKY = N
 *
-*     Set the block size NB and the crossover point NX.
+      IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
 *
-      NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) )
+*        Set the crossover point NX.
 *
-      IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
+         NX = MAX( NB, ILAENV( 3, 'ZGEBRD', ' ', M, N, -1, -1 ) )
 *
 *        Determine when to switch from blocked to unblocked code.
 *
-         NX = MAX( NB, ILAENV( 3, 'ZGEBRD', ' ', M, N, -1, -1 ) )
          IF( NX.LT.MINMN ) THEN
             WS = ( M+N )*NB
             IF( LWORK.LT.WS ) THEN
diff --git a/libcruft/lapack/zgeesx.f b/libcruft/lapack/zgeesx.f
--- a/libcruft/lapack/zgeesx.f
+++ b/libcruft/lapack/zgeesx.f
@@ -2,10 +2,10 @@
      $                   VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK,
      $                   BWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     March 31, 1993
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBVS, SENSE, SORT
@@ -158,8 +158,8 @@
       DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL,
-     $                   ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
+      EXTERNAL           DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD,
+     $                   ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
@@ -211,7 +211,7 @@
 *       in the code.)
 *
       MINWRK = 1
-      IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 ) ) THEN
          MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
          MINWRK = MAX( 1, 2*N )
          IF( .NOT.WANTVS ) THEN
diff --git a/libcruft/lapack/zgeev.f b/libcruft/lapack/zgeev.f
--- a/libcruft/lapack/zgeev.f
+++ b/libcruft/lapack/zgeev.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
      $                  WORK, LWORK, RWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBVL, JOBVR
@@ -85,6 +85,11 @@
 *          The dimension of the array WORK.  LWORK >= max(1,2*N).
 *          For good performance, LWORK must generally be larger.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
 *
 *  INFO    (output) INTEGER
@@ -102,7 +107,7 @@
       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            SCALEA, WANTVL, WANTVR
+      LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR
       CHARACTER          SIDE
       INTEGER            HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
      $                   IWRK, K, MAXB, MAXWRK, MINWRK, NOUT
@@ -114,8 +119,8 @@
       DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
-     $                   ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR
+      EXTERNAL           XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEQR,
+     $                   ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
@@ -131,6 +136,7 @@
 *     Test the input arguments
 *
       INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
       WANTVL = LSAME( JOBVL, 'V' )
       WANTVR = LSAME( JOBVR, 'V' )
       IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
@@ -159,7 +165,7 @@
 *       the worst case.)
 *
       MINWRK = 1
-      IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
          MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
          IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
             MINWRK = MAX( 1, 2*N )
@@ -180,12 +186,14 @@
          END IF
          WORK( 1 ) = MAXWRK
       END IF
-      IF( LWORK.LT.MINWRK ) THEN
+      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
          INFO = -12
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGEEV ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
diff --git a/libcruft/lapack/zgehd2.f b/libcruft/lapack/zgehd2.f
--- a/libcruft/lapack/zgehd2.f
+++ b/libcruft/lapack/zgehd2.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgehrd.f b/libcruft/lapack/zgehrd.f
--- a/libcruft/lapack/zgehrd.f
+++ b/libcruft/lapack/zgehrd.f
@@ -1,15 +1,15 @@
       SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -56,6 +56,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
@@ -103,7 +108,9 @@
      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, LDWORK, NB, NBMIN, NH, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, LDWORK, LWKOPT, NB, NBMIN,
+     $                   NH, NX
       COMPLEX*16         EI
 *     ..
 *     .. Local Arrays ..
@@ -124,6 +131,10 @@
 *     Test the input parameters
 *
       INFO = 0
+      NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
+      LWKOPT = N*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( N.LT.0 ) THEN
          INFO = -1
       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
@@ -132,12 +143,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGEHRD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
@@ -157,9 +170,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
       NBMIN = 2
       IWS = 1
       IF( NB.GT.1 .AND. NB.LT.NH ) THEN
diff --git a/libcruft/lapack/zgelq2.f b/libcruft/lapack/zgelq2.f
--- a/libcruft/lapack/zgelq2.f
+++ b/libcruft/lapack/zgelq2.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgelqf.f b/libcruft/lapack/zgelqf.f
--- a/libcruft/lapack/zgelqf.f
+++ b/libcruft/lapack/zgelqf.f
@@ -1,15 +1,15 @@
       SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -50,6 +50,11 @@
 *          For optimum performance LWORK >= M*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -72,7 +77,9 @@
 *  =====================================================================
 *
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, NB, NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
+     $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZGELQ2, ZLARFB, ZLARFT
@@ -89,18 +96,24 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
+      LWKOPT = M*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGELQF', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -111,9 +124,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
       NBMIN = 2
       NX = 0
       IWS = M
diff --git a/libcruft/lapack/zgelss.f b/libcruft/lapack/zgelss.f
--- a/libcruft/lapack/zgelss.f
+++ b/libcruft/lapack/zgelss.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
      $                   WORK, LWORK, RWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
@@ -87,6 +87,11 @@
 *          LWORK >=  2*min(M,N) + max(M,N,NRHS)
 *          For good performance, LWORK should generally be larger.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  RWORK   (workspace) DOUBLE PRECISION array, dimension (5*min(M,N)-1)
 *
 *  INFO    (output) INTEGER
@@ -100,12 +105,13 @@
 *
 *     .. Parameters ..
       DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
       COMPLEX*16         CZERO, CONE
-      PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
-     $                   CONE = ( 1.0D0, 0.0D0 ) )
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
+      LOGICAL            LQUERY
       INTEGER            BL, CHUNK, I, IASCL, IBSCL, IE, IL, IRWORK,
      $                   ITAU, ITAUP, ITAUQ, IWORK, LDWORK, MAXMN,
      $                   MAXWRK, MINMN, MINWRK, MM, MNTHR
@@ -136,6 +142,7 @@
       MINMN = MIN( M, N )
       MAXMN = MAX( M, N )
       MNTHR = ILAENV( 6, 'ZGELSS', ' ', M, N, NRHS, -1 )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
@@ -157,7 +164,7 @@
 *       immediately following subroutine, as returned by ILAENV.)
 *
       MINWRK = 1
-      IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
          MAXWRK = 0
          MM = M
          IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -170,7 +177,7 @@
             MAXWRK = MAX( MAXWRK, N+N*ILAENV( 1, 'ZGEQRF', ' ', M, N,
      $               -1, -1 ) )
             MAXWRK = MAX( MAXWRK, N+NRHS*
-     $               ILAENV( 1, 'ZUNMQR', 'LT', M, NRHS, N, -1 ) )
+     $               ILAENV( 1, 'ZUNMQR', 'LC', M, NRHS, N, -1 ) )
          END IF
          IF( M.GE.N ) THEN
 *
@@ -209,7 +216,7 @@
                   MAXWRK = MAX( MAXWRK, M*M+2*M )
                END IF
                MAXWRK = MAX( MAXWRK, M+NRHS*
-     $                  ILAENV( 1, 'ZUNMLQ', 'LT', N, NRHS, M, -1 ) )
+     $                  ILAENV( 1, 'ZUNMLQ', 'LC', N, NRHS, M, -1 ) )
             ELSE
 *
 *              Path 2 - underdetermined
@@ -219,7 +226,7 @@
                MAXWRK = 2*M + ( N+M )*ILAENV( 1, 'ZGEBRD', ' ', M, N,
      $                  -1, -1 )
                MAXWRK = MAX( MAXWRK, 2*M+NRHS*
-     $                  ILAENV( 1, 'ZUNMBR', 'QLT', M, NRHS, M, -1 ) )
+     $                  ILAENV( 1, 'ZUNMBR', 'QLC', M, NRHS, M, -1 ) )
                MAXWRK = MAX( MAXWRK, 2*M+M*
      $                  ILAENV( 1, 'ZUNGBR', 'P', M, N, M, -1 ) )
                MAXWRK = MAX( MAXWRK, N*NRHS )
@@ -230,11 +237,13 @@
          WORK( 1 ) = MAXWRK
       END IF
 *
-      IF( LWORK.LT.MINWRK )
+      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
      $   INFO = -12
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGELSS', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -398,9 +407,9 @@
             CHUNK = LWORK / N
             DO 20 I = 1, NRHS, CHUNK
                BL = MIN( NRHS-I+1, CHUNK )
-               CALL ZGEMM( 'C', 'N', N, BL, N, CONE, A, LDA, B, LDB,
-     $                     CZERO, WORK, N )
-               CALL ZLACPY( 'G', N, BL, WORK, N, B, LDB )
+               CALL ZGEMM( 'C', 'N', N, BL, N, CONE, A, LDA, B( 1, I ),
+     $                     LDB, CZERO, WORK, N )
+               CALL ZLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
    20       CONTINUE
          ELSE
             CALL ZGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
@@ -504,7 +513,8 @@
                BL = MIN( NRHS-I+1, CHUNK )
                CALL ZGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), LDWORK,
      $                     B( 1, I ), LDB, CZERO, WORK( IWORK ), N )
-               CALL ZLACPY( 'G', M, BL, WORK( IWORK ), N, B, LDB )
+               CALL ZLACPY( 'G', M, BL, WORK( IWORK ), N, B( 1, I ),
+     $                      LDB )
    40       CONTINUE
          ELSE
             CALL ZGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, 1 ),
diff --git a/libcruft/lapack/zgeqpf.f b/libcruft/lapack/zgeqpf.f
--- a/libcruft/lapack/zgeqpf.f
+++ b/libcruft/lapack/zgeqpf.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZGEQPF( M, N, A, LDA, JPVT, TAU, WORK, RWORK, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     March 31, 1993
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, M, N
@@ -17,6 +17,8 @@
 *  Purpose
 *  =======
 *
+*  This routine is deprecated and has been replaced by routine ZGEQP3.
+*
 *  ZGEQPF computes a QR factorization with column pivoting of a
 *  complex M-by-N matrix A: A*P = Q*R.
 *
@@ -34,7 +36,7 @@
 *          On exit, the upper triangle of the array contains the
 *          min(M,N)-by-N upper triangular matrix R; the elements
 *          below the diagonal, together with the array TAU,
-*          represent the orthogonal matrix Q as a product of
+*          represent the unitary matrix Q as a product of
 *          min(m,n) elementary reflectors.
 *
 *  LDA     (input) INTEGER
diff --git a/libcruft/lapack/zgeqr2.f b/libcruft/lapack/zgeqr2.f
--- a/libcruft/lapack/zgeqr2.f
+++ b/libcruft/lapack/zgeqr2.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgeqrf.f b/libcruft/lapack/zgeqrf.f
--- a/libcruft/lapack/zgeqrf.f
+++ b/libcruft/lapack/zgeqrf.f
@@ -1,15 +1,15 @@
       SUBROUTINE ZGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -51,6 +51,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -73,7 +78,9 @@
 *  =====================================================================
 *
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, NB, NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
+     $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZGEQR2, ZLARFB, ZLARFT
@@ -90,18 +97,24 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
+      LWKOPT = N*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGEQRF', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -112,9 +125,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
       NBMIN = 2
       NX = 0
       IWS = N
diff --git a/libcruft/lapack/zgesv.f b/libcruft/lapack/zgesv.f
--- a/libcruft/lapack/zgesv.f
+++ b/libcruft/lapack/zgesv.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
diff --git a/libcruft/lapack/zgesvd.f b/libcruft/lapack/zgesvd.f
--- a/libcruft/lapack/zgesvd.f
+++ b/libcruft/lapack/zgesvd.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
      $                   WORK, LWORK, RWORK, INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBU, JOBVT
@@ -114,6 +114,11 @@
 *          LWORK >=  2*MIN(M,N)+MAX(M,N).
 *          For good performance, LWORK should generally be larger.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  RWORK   (workspace) DOUBLE PRECISION array, dimension
 *                                  (max(3*min(M,N),5*min(M,N)-4))
 *          On exit, if INFO > 0, RWORK(1:MIN(M,N)-1) contains the
@@ -140,8 +145,8 @@
       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS, WNTVA,
-     $                   WNTVAS, WNTVN, WNTVO, WNTVS
+      LOGICAL            LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
+     $                   WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
       INTEGER            BLK, CHUNK, I, IE, IERR, IR, IRWORK, ISCL,
      $                   ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
      $                   MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
@@ -184,6 +189,7 @@
       WNTVO = LSAME( JOBVT, 'O' )
       WNTVN = LSAME( JOBVT, 'N' )
       MINWRK = 1
+      LQUERY = ( LWORK.EQ.-1 )
 *
       IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
          INFO = -1
@@ -211,7 +217,8 @@
 *       real workspace. NB refers to the optimal block size for the
 *       immediately following subroutine, as returned by ILAENV.)
 *
-      IF( INFO.EQ.0 .AND. LWORK.GE.1 .AND. M.GT.0 .AND. N.GT.0 ) THEN
+      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
+     $    N.GT.0 ) THEN
          IF( M.GE.N ) THEN
 *
 *           Space needed for ZBDSQR is BDSPAC = MAX( 3*N, 5*N-4 )
@@ -540,12 +547,14 @@
          WORK( 1 ) = MAXWRK
       END IF
 *
-      IF( LWORK.LT.MINWRK ) THEN
+      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
          INFO = -13
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGESVD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
diff --git a/libcruft/lapack/zgetf2.f b/libcruft/lapack/zgetf2.f
--- a/libcruft/lapack/zgetf2.f
+++ b/libcruft/lapack/zgetf2.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGETF2( M, N, A, LDA, IPIV, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgetrf.f b/libcruft/lapack/zgetrf.f
--- a/libcruft/lapack/zgetrf.f
+++ b/libcruft/lapack/zgetrf.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zgetrs.f b/libcruft/lapack/zgetrs.f
--- a/libcruft/lapack/zgetrs.f
+++ b/libcruft/lapack/zgetrs.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zggbal.f b/libcruft/lapack/zggbal.f
--- a/libcruft/lapack/zggbal.f
+++ b/libcruft/lapack/zggbal.f
@@ -1,7 +1,7 @@
       SUBROUTINE ZGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
      $                   RSCALE, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zheev.f b/libcruft/lapack/zheev.f
--- a/libcruft/lapack/zheev.f
+++ b/libcruft/lapack/zheev.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
      $                  INFO )
 *
-*  -- LAPACK driver routine (version 2.0) --
+*  -- LAPACK driver routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          JOBZ, UPLO
@@ -61,6 +61,11 @@
 *          For optimal efficiency, LWORK >= (NB+1)*N,
 *          where NB is the blocksize for ZHETRD returned by ILAENV.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  RWORK   (workspace) DOUBLE PRECISION array, dimension (max(1, 3*N-2))
 *
 *  INFO    (output) INTEGER
@@ -79,16 +84,17 @@
       PARAMETER          ( CONE = ( 1.0D0, 0.0D0 ) )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            LOWER, WANTZ
+      LOGICAL            LOWER, LQUERY, WANTZ
       INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
-     $                   LLWORK, LOPT
+     $                   LLWORK, LOPT, LWKOPT, NB
       DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
      $                   SMLNUM
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
+      INTEGER            ILAENV
       DOUBLE PRECISION   DLAMCH, ZLANHE
-      EXTERNAL           LSAME, DLAMCH, ZLANHE
+      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANHE
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DSCAL, DSTERF, XERBLA, ZHETRD, ZLASCL, ZSTEQR,
@@ -103,6 +109,7 @@
 *
       WANTZ = LSAME( JOBZ, 'V' )
       LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
       INFO = 0
       IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
@@ -113,13 +120,21 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, 2*N-1 ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 2*N-1 ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
 *
+      IF( INFO.EQ.0 ) THEN
+         NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
+         LWKOPT = MAX( 1, ( NB+1 )*N )
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZHEEV ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -196,7 +211,7 @@
 *
 *     Set WORK(1) to optimal complex workspace size.
 *
-      WORK( 1 ) = MAX( 2*N-1, LOPT )
+      WORK( 1 ) = LWKOPT
 *
       RETURN
 *
diff --git a/libcruft/lapack/zhetd2.f b/libcruft/lapack/zhetd2.f
--- a/libcruft/lapack/zhetd2.f
+++ b/libcruft/lapack/zhetd2.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zhetrd.f b/libcruft/lapack/zhetrd.f
--- a/libcruft/lapack/zhetrd.f
+++ b/libcruft/lapack/zhetrd.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
@@ -73,6 +73,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -129,8 +134,9 @@
       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            I, IINFO, IWS, J, KK, LDWORK, NB, NBMIN, NX
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
+     $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZHER2K, ZHETD2, ZLATRD
@@ -149,18 +155,31 @@
 *
       INFO = 0
       UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.1 ) THEN
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
          INFO = -9
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size.
+*
+         NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZHETRD', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -170,9 +189,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
       NX = N
       IWS = 1
       IF( NB.GT.1 .AND. NB.LT.N ) THEN
@@ -273,7 +289,7 @@
      $                TAU( I ), IINFO )
       END IF
 *
-      WORK( 1 ) = IWS
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of ZHETRD
diff --git a/libcruft/lapack/zhseqr.f b/libcruft/lapack/zhseqr.f
--- a/libcruft/lapack/zhseqr.f
+++ b/libcruft/lapack/zhseqr.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
      $                   WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          COMPZ, JOB
@@ -82,10 +82,16 @@
 *          The leading dimension of the array Z.
 *          LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise.
 *
-*  WORK    (workspace) COMPLEX*16 array, dimension (N)
+*  WORK    (workspace/output) COMPLEX*16 array, dimension (LWORK)
+*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *
 *  LWORK   (input) INTEGER
-*          This argument is currently redundant.
+*          The dimension of the array WORK.  LWORK >= max(1,N).
+*
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
 *
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
@@ -108,7 +114,7 @@
       PARAMETER          ( NSMAX = 15, LDS = NSMAX )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            INITZ, WANTT, WANTZ
+      LOGICAL            INITZ, LQUERY, WANTT, WANTZ
       INTEGER            I, I1, I2, IERR, II, ITEMP, ITN, ITS, J, K, L,
      $                   MAXB, NH, NR, NS, NV
       DOUBLE PRECISION   OVFL, RTEMP, SMLNUM, TST1, ULP, UNFL
@@ -125,8 +131,8 @@
       EXTERNAL           LSAME, ILAENV, IZAMAX, DLAMCH, DLAPY2, ZLANHS
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLACPY,
-     $                   ZLAHQR, ZLARFG, ZLARFX, ZLASET, ZSCAL
+      EXTERNAL           XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLACPY, ZLAHQR,
+     $                   ZLARFG, ZLARFX, ZLASET, ZSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, MIN
@@ -146,6 +152,8 @@
       WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
 *
       INFO = 0
+      WORK( 1 ) = MAX( 1, N )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
          INFO = -1
       ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
@@ -160,10 +168,14 @@
          INFO = -7
       ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. LDZ.LT.MAX( 1, N ) ) THEN
          INFO = -10
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+         INFO = -12
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZHSEQR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Initialize Z, if necessary
@@ -454,6 +466,7 @@
       GO TO 60
 *
   180 CONTINUE
+      WORK( 1 ) = MAX( 1, N )
       RETURN
 *
 *     End of ZHSEQR
diff --git a/libcruft/lapack/zlabrd.f b/libcruft/lapack/zlabrd.f
--- a/libcruft/lapack/zlabrd.f
+++ b/libcruft/lapack/zlabrd.f
@@ -1,7 +1,7 @@
       SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
      $                   LDY )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zlacgv.f b/libcruft/lapack/zlacgv.f
--- a/libcruft/lapack/zlacgv.f
+++ b/libcruft/lapack/zlacgv.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLACGV( N, X, INCX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zlacon.f b/libcruft/lapack/zlacon.f
--- a/libcruft/lapack/zlacon.f
+++ b/libcruft/lapack/zlacon.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZLACON( N, V, X, EST, KASE )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            KASE, N
@@ -55,6 +55,8 @@
 *  a real or complex matrix, with applications to condition estimation",
 *  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
 *
+*  Last modified:  April, 1999
+*
 *  =====================================================================
 *
 *     .. Parameters ..
@@ -68,7 +70,7 @@
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, ITER, J, JLAST, JUMP
-      DOUBLE PRECISION   ALTSGN, ESTOLD, SAFMIN, TEMP
+      DOUBLE PRECISION   ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
 *     ..
 *     .. External Functions ..
       INTEGER            IZMAX1
@@ -79,7 +81,7 @@
       EXTERNAL           ZCOPY
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX
+      INTRINSIC          ABS, DBLE, DCMPLX, DIMAG
 *     ..
 *     .. Save statement ..
       SAVE
@@ -111,8 +113,10 @@
       EST = DZSUM1( N, X, 1 )
 *
       DO 30 I = 1, N
-         IF( ABS( X( I ) ).GT.SAFMIN ) THEN
-            X( I ) = X( I ) / DCMPLX( ABS( X( I ) ) )
+         ABSXI = ABS( X( I ) )
+         IF( ABSXI.GT.SAFMIN ) THEN
+            X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
+     $               DIMAG( X( I ) ) / ABSXI )
          ELSE
             X( I ) = CONE
          END IF
@@ -152,8 +156,10 @@
      $   GO TO 100
 *
       DO 80 I = 1, N
-         IF( ABS( X( I ) ).GT.SAFMIN ) THEN
-            X( I ) = X( I ) / DCMPLX( ABS( X( I ) ) )
+         ABSXI = ABS( X( I ) )
+         IF( ABSXI.GT.SAFMIN ) THEN
+            X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
+     $               DIMAG( X( I ) ) / ABSXI )
          ELSE
             X( I ) = CONE
          END IF
@@ -168,7 +174,7 @@
    90 CONTINUE
       JLAST = J
       J = IZMAX1( N, X, 1 )
-      IF( ( DBLE( X( JLAST ) ).NE.ABS( DBLE( X( J ) ) ) ) .AND.
+      IF( ( ABS( X( JLAST ) ).NE.ABS( X( J ) ) ) .AND.
      $    ( ITER.LT.ITMAX ) ) THEN
          ITER = ITER + 1
          GO TO 50
diff --git a/libcruft/lapack/zlacpy.f b/libcruft/lapack/zlacpy.f
--- a/libcruft/lapack/zlacpy.f
+++ b/libcruft/lapack/zlacpy.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/zladiv.f b/libcruft/lapack/zladiv.f
--- a/libcruft/lapack/zladiv.f
+++ b/libcruft/lapack/zladiv.f
@@ -1,6 +1,6 @@
       DOUBLE COMPLEX   FUNCTION ZLADIV( X, Y )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zlahqr.f b/libcruft/lapack/zlahqr.f
--- a/libcruft/lapack/zlahqr.f
+++ b/libcruft/lapack/zlahqr.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
      $                   IHIZ, Z, LDZ, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       LOGICAL            WANTT, WANTZ
@@ -89,14 +89,14 @@
       COMPLEX*16         ZERO, ONE
       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-      DOUBLE PRECISION   RZERO, RONE, HALF
-      PARAMETER          ( RZERO = 0.0D+0, RONE = 1.0D+0,
-     $                   HALF = 0.5D+0 )
+      DOUBLE PRECISION   RZERO, HALF
+      PARAMETER          ( RZERO = 0.0D+0, HALF = 0.5D+0 )
+      DOUBLE PRECISION   DAT1
+      PARAMETER          ( DAT1 = 0.75D+0 )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, I1, I2, ITN, ITS, J, K, L, M, NH, NZ
-      DOUBLE PRECISION   H10, H21, OVFL, RTEMP, S, SMLNUM, T2, TST1,
-     $                   ULP, UNFL
+      DOUBLE PRECISION   H10, H21, RTEMP, S, SMLNUM, T2, TST1, ULP
       COMPLEX*16         CDUM, H11, H11S, H22, SUM, T, T1, TEMP, U, V2,
      $                   X, Y
 *     ..
@@ -105,12 +105,12 @@
       COMPLEX*16         V( 2 )
 *     ..
 *     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLAPY2, ZLANHS
+      DOUBLE PRECISION   DLAMCH, ZLANHS
       COMPLEX*16         ZLADIV
-      EXTERNAL           DLAMCH, DLAPY2, ZLANHS, ZLADIV
+      EXTERNAL           DLAMCH, ZLANHS, ZLADIV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, ZCOPY, ZLARFG, ZSCAL
+      EXTERNAL           ZCOPY, ZLARFG, ZSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT
@@ -140,11 +140,8 @@
 *     Set machine-dependent constants for the stopping criterion.
 *     If norm(H) <= sqrt(OVFL), overflow should not occur.
 *
-      UNFL = DLAMCH( 'Safe minimum' )
-      OVFL = RONE / UNFL
-      CALL DLABAD( UNFL, OVFL )
       ULP = DLAMCH( 'Precision' )
-      SMLNUM = UNFL*( NH / ULP )
+      SMLNUM = DLAMCH( 'Safe minimum' ) / ULP
 *
 *     I1 and I2 are the indices of the first row and last column of H
 *     to which transformations must be applied. If eigenvalues only are
@@ -213,8 +210,8 @@
 *
 *           Exceptional shift.
 *
-            T = ABS( DBLE( H( I, I-1 ) ) ) +
-     $          ABS( DBLE( H( I-1, I-2 ) ) )
+            S = DAT1*ABS( DBLE( H( I, I-1 ) ) )
+            T = S + H( I, I )
          ELSE
 *
 *           Wilkinson's shift.
@@ -232,7 +229,7 @@
 *
 *        Look for two consecutive small subdiagonal elements.
 *
-         DO 40 M = I - 1, L, -1
+         DO 40 M = I - 1, L + 1, -1
 *
 *           Determine the effect of starting the single-shift QR
 *           iteration at row M, and see if this would make H(M,M-1)
@@ -247,13 +244,20 @@
             H21 = H21 / S
             V( 1 ) = H11S
             V( 2 ) = H21
-            IF( M.EQ.L )
-     $         GO TO 50
             H10 = H( M, M-1 )
             TST1 = CABS1( H11S )*( CABS1( H11 )+CABS1( H22 ) )
             IF( ABS( H10*H21 ).LE.ULP*TST1 )
      $         GO TO 50
    40    CONTINUE
+         H11 = H( L, L )
+         H22 = H( L+1, L+1 )
+         H11S = H11 - T
+         H21 = H( L+1, L )
+         S = CABS1( H11S ) + ABS( H21 )
+         H11S = H11S / S
+         H21 = H21 / S
+         V( 1 ) = H11S
+         V( 2 ) = H21
    50    CONTINUE
 *
 *        Single-shift QR step
@@ -319,7 +323,7 @@
 *              real.
 *
                TEMP = ONE - T1
-               TEMP = TEMP / DLAPY2( DBLE( TEMP ), DIMAG( TEMP ) )
+               TEMP = TEMP / ABS( TEMP )
                H( M+1, M ) = H( M+1, M )*DCONJG( TEMP )
                IF( M+2.LE.I )
      $            H( M+2, M+1 ) = H( M+2, M+1 )*TEMP
@@ -341,7 +345,7 @@
 *
          TEMP = H( I, I-1 )
          IF( DIMAG( TEMP ).NE.RZERO ) THEN
-            RTEMP = DLAPY2( DBLE( TEMP ), DIMAG( TEMP ) )
+            RTEMP = ABS( TEMP )
             H( I, I-1 ) = RTEMP
             TEMP = TEMP / RTEMP
             IF( I2.GT.I )
diff --git a/libcruft/lapack/zlahrd.f b/libcruft/lapack/zlahrd.f
--- a/libcruft/lapack/zlahrd.f
+++ b/libcruft/lapack/zlahrd.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            K, LDA, LDT, LDY, N, NB
@@ -53,7 +53,7 @@
 *          The scalar factors of the elementary reflectors. See Further
 *          Details.
 *
-*  T       (output) COMPLEX*16 array, dimension (NB,NB)
+*  T       (output) COMPLEX*16 array, dimension (LDT,NB)
 *          The upper triangular matrix T.
 *
 *  LDT     (input) INTEGER
diff --git a/libcruft/lapack/zlange.f b/libcruft/lapack/zlange.f
--- a/libcruft/lapack/zlange.f
+++ b/libcruft/lapack/zlange.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION ZLANGE( NORM, M, N, A, LDA, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zlanhe.f b/libcruft/lapack/zlanhe.f
--- a/libcruft/lapack/zlanhe.f
+++ b/libcruft/lapack/zlanhe.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zlanhs.f b/libcruft/lapack/zlanhs.f
--- a/libcruft/lapack/zlanhs.f
+++ b/libcruft/lapack/zlanhs.f
@@ -1,6 +1,6 @@
       DOUBLE PRECISION FUNCTION ZLANHS( NORM, N, A, LDA, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zlarf.f b/libcruft/lapack/zlarf.f
--- a/libcruft/lapack/zlarf.f
+++ b/libcruft/lapack/zlarf.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zlarfb.f b/libcruft/lapack/zlarfb.f
--- a/libcruft/lapack/zlarfb.f
+++ b/libcruft/lapack/zlarfb.f
@@ -1,7 +1,7 @@
       SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
      $                   T, LDT, C, LDC, WORK, LDWORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zlarfg.f b/libcruft/lapack/zlarfg.f
--- a/libcruft/lapack/zlarfg.f
+++ b/libcruft/lapack/zlarfg.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zlarft.f b/libcruft/lapack/zlarft.f
--- a/libcruft/lapack/zlarft.f
+++ b/libcruft/lapack/zlarft.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zlarfx.f b/libcruft/lapack/zlarfx.f
--- a/libcruft/lapack/zlarfx.f
+++ b/libcruft/lapack/zlarfx.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zlartg.f b/libcruft/lapack/zlartg.f
--- a/libcruft/lapack/zlartg.f
+++ b/libcruft/lapack/zlartg.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZLARTG( F, G, CS, SN, R )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION   CS
@@ -23,8 +23,7 @@
 *  the following differences:
 *     F and G are unchanged on return.
 *     If G=0, then CS=1 and SN=0.
-*     If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
-*        floating point operations.
+*     If F=0, then CS=0 and SN is chosen so that R is real.
 *
 *  Arguments
 *  =========
@@ -44,70 +43,147 @@
 *  R       (output) COMPLEX*16
 *          The nonzero component of the rotated vector.
 *
+*  Further Details
+*  ======= =======
+*
+*  3-5-96 - Modified with a new algorithm by W. Kahan and J. Demmel
+*
 *  =====================================================================
 *
 *     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      DOUBLE PRECISION   TWO, ONE, ZERO
+      PARAMETER          ( TWO = 2.0D+0, ONE = 1.0D+0, ZERO = 0.0D+0 )
       COMPLEX*16         CZERO
       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      DOUBLE PRECISION   D, DI, F1, F2, FA, G1, G2, GA
-      COMPLEX*16         FS, GS, SS, T
+      LOGICAL            FIRST
+      INTEGER            COUNT, I
+      DOUBLE PRECISION   D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN,
+     $                   SAFMN2, SAFMX2, SCALE
+      COMPLEX*16         FF, FS, GS
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH, DLAPY2
+      EXTERNAL           DLAMCH, DLAPY2
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCONJG, DIMAG, SQRT
+      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, LOG,
+     $                   MAX, SQRT
 *     ..
 *     .. Statement Functions ..
       DOUBLE PRECISION   ABS1, ABSSQ
 *     ..
+*     .. Save statement ..
+      SAVE               FIRST, SAFMX2, SAFMIN, SAFMN2
+*     ..
+*     .. Data statements ..
+      DATA               FIRST / .TRUE. /
+*     ..
 *     .. Statement Function definitions ..
-      ABS1( T ) = ABS( DBLE( T ) ) + ABS( DIMAG( T ) )
-      ABSSQ( T ) = DBLE( T )**2 + DIMAG( T )**2
+      ABS1( FF ) = MAX( ABS( DBLE( FF ) ), ABS( DIMAG( FF ) ) )
+      ABSSQ( FF ) = DBLE( FF )**2 + DIMAG( FF )**2
 *     ..
 *     .. Executable Statements ..
 *
-*     [ 25 or 38 ops for main paths ]
+      IF( FIRST ) THEN
+         FIRST = .FALSE.
+         SAFMIN = DLAMCH( 'S' )
+         EPS = DLAMCH( 'E' )
+         SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
+     $            LOG( DLAMCH( 'B' ) ) / TWO )
+         SAFMX2 = ONE / SAFMN2
+      END IF
+      SCALE = MAX( ABS1( F ), ABS1( G ) )
+      FS = F
+      GS = G
+      COUNT = 0
+      IF( SCALE.GE.SAFMX2 ) THEN
+   10    CONTINUE
+         COUNT = COUNT + 1
+         FS = FS*SAFMN2
+         GS = GS*SAFMN2
+         SCALE = SCALE*SAFMN2
+         IF( SCALE.GE.SAFMX2 )
+     $      GO TO 10
+      ELSE IF( SCALE.LE.SAFMN2 ) THEN
+         IF( G.EQ.CZERO ) THEN
+            CS = ONE
+            SN = CZERO
+            R = F
+            RETURN
+         END IF
+   20    CONTINUE
+         COUNT = COUNT - 1
+         FS = FS*SAFMX2
+         GS = GS*SAFMX2
+         SCALE = SCALE*SAFMX2
+         IF( SCALE.LE.SAFMN2 )
+     $      GO TO 20
+      END IF
+      F2 = ABSSQ( FS )
+      G2 = ABSSQ( GS )
+      IF( F2.LE.MAX( G2, ONE )*SAFMIN ) THEN
 *
-      IF( G.EQ.CZERO ) THEN
-         CS = ONE
-         SN = ZERO
-         R = F
-      ELSE IF( F.EQ.CZERO ) THEN
-         CS = ZERO
+*        This is a rare case: F is very small.
 *
-         SN = DCONJG( G ) / ABS( G )
-         R = ABS( G )
-*
-*         SN = ONE
-*         R = G
-*
+         IF( F.EQ.CZERO ) THEN
+            CS = ZERO
+            R = DLAPY2( DBLE( G ), DIMAG( G ) )
+*           Do complex/real division explicitly with two real divisions
+            D = DLAPY2( DBLE( GS ), DIMAG( GS ) )
+            SN = DCMPLX( DBLE( GS ) / D, -DIMAG( GS ) / D )
+            RETURN
+         END IF
+         F2S = DLAPY2( DBLE( FS ), DIMAG( FS ) )
+*        G2 and G2S are accurate
+*        G2 is at least SAFMIN, and G2S is at least SAFMN2
+         G2S = SQRT( G2 )
+*        Error in CS from underflow in F2S is at most
+*        UNFL / SAFMN2 .lt. sqrt(UNFL*EPS) .lt. EPS
+*        If MAX(G2,ONE)=G2, then F2 .lt. G2*SAFMIN,
+*        and so CS .lt. sqrt(SAFMIN)
+*        If MAX(G2,ONE)=ONE, then F2 .lt. SAFMIN
+*        and so CS .lt. sqrt(SAFMIN)/SAFMN2 = sqrt(EPS)
+*        Therefore, CS = F2S/G2S / sqrt( 1 + (F2S/G2S)**2 ) = F2S/G2S
+         CS = F2S / G2S
+*        Make sure abs(FF) = 1
+*        Do complex/real division explicitly with 2 real divisions
+         IF( ABS1( F ).GT.ONE ) THEN
+            D = DLAPY2( DBLE( F ), DIMAG( F ) )
+            FF = DCMPLX( DBLE( F ) / D, DIMAG( F ) / D )
+         ELSE
+            DR = SAFMX2*DBLE( F )
+            DI = SAFMX2*DIMAG( F )
+            D = DLAPY2( DR, DI )
+            FF = DCMPLX( DR / D, DI / D )
+         END IF
+         SN = FF*DCMPLX( DBLE( GS ) / G2S, -DIMAG( GS ) / G2S )
+         R = CS*F + SN*G
       ELSE
-         F1 = ABS1( F )
-         G1 = ABS1( G )
-         IF( F1.GE.G1 ) THEN
-            GS = G / F1
-            G2 = ABSSQ( GS )
-            FS = F / F1
-            F2 = ABSSQ( FS )
-            D = SQRT( ONE+G2 / F2 )
-            CS = ONE / D
-            SN = DCONJG( GS )*FS*( CS / F2 )
-            R = F*D
-         ELSE
-            FS = F / G1
-            F2 = ABSSQ( FS )
-            FA = SQRT( F2 )
-            GS = G / G1
-            G2 = ABSSQ( GS )
-            GA = SQRT( G2 )
-            D = SQRT( ONE+F2 / G2 )
-            DI = ONE / D
-            CS = ( FA / GA )*DI
-            SS = ( DCONJG( GS )*FS ) / ( FA*GA )
-            SN = SS*DI
-            R = G*SS*D
+*
+*        This is the most common case.
+*        Neither F2 nor F2/G2 are less than SAFMIN
+*        F2S cannot overflow, and it is accurate
+*
+         F2S = SQRT( ONE+G2 / F2 )
+*        Do the F2S(real)*FS(complex) multiply with two real multiplies
+         R = DCMPLX( F2S*DBLE( FS ), F2S*DIMAG( FS ) )
+         CS = ONE / F2S
+         D = F2 + G2
+*        Do complex/real division explicitly with two real divisions
+         SN = DCMPLX( DBLE( R ) / D, DIMAG( R ) / D )
+         SN = SN*DCONJG( GS )
+         IF( COUNT.NE.0 ) THEN
+            IF( COUNT.GT.0 ) THEN
+               DO 30 I = 1, COUNT
+                  R = R*SAFMX2
+   30          CONTINUE
+            ELSE
+               DO 40 I = 1, -COUNT
+                  R = R*SAFMN2
+   40          CONTINUE
+            END IF
          END IF
       END IF
       RETURN
diff --git a/libcruft/lapack/zlascl.f b/libcruft/lapack/zlascl.f
--- a/libcruft/lapack/zlascl.f
+++ b/libcruft/lapack/zlascl.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
diff --git a/libcruft/lapack/zlaset.f b/libcruft/lapack/zlaset.f
--- a/libcruft/lapack/zlaset.f
+++ b/libcruft/lapack/zlaset.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zlasr.f b/libcruft/lapack/zlasr.f
--- a/libcruft/lapack/zlasr.f
+++ b/libcruft/lapack/zlasr.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zlassq.f b/libcruft/lapack/zlassq.f
--- a/libcruft/lapack/zlassq.f
+++ b/libcruft/lapack/zlassq.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INCX, N
@@ -41,7 +41,7 @@
 *  N       (input) INTEGER
 *          The number of elements to be used from the vector X.
 *
-*  X       (input) DOUBLE PRECISION
+*  X       (input) COMPLEX*16 array, dimension (N)
 *          The vector x as described above.
 *             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
 *
diff --git a/libcruft/lapack/zlaswp.f b/libcruft/lapack/zlaswp.f
--- a/libcruft/lapack/zlaswp.f
+++ b/libcruft/lapack/zlaswp.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZLASWP( N, A, LDA, K1, K2, IPIV, INCX )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INCX, K1, K2, LDA, N
@@ -50,45 +50,67 @@
 *          The increment between successive values of IPIV.  If IPIV
 *          is negative, the pivots are applied in reverse order.
 *
+*  Further Details
+*  ===============
+*
+*  Modified by
+*   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
 * =====================================================================
 *
 *     .. Local Scalars ..
-      INTEGER            I, IP, IX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZSWAP
+      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
+      COMPLEX*16         TEMP
 *     ..
 *     .. Executable Statements ..
 *
 *     Interchange row I with row IPIV(I) for each of rows K1 through K2.
 *
-      IF( INCX.EQ.0 )
-     $   RETURN
       IF( INCX.GT.0 ) THEN
-         IX = K1
+         IX0 = K1
+         I1 = K1
+         I2 = K2
+         INC = 1
+      ELSE IF( INCX.LT.0 ) THEN
+         IX0 = 1 + ( 1-K2 )*INCX
+         I1 = K2
+         I2 = K1
+         INC = -1
       ELSE
-         IX = 1 + ( 1-K2 )*INCX
+         RETURN
       END IF
-      IF( INCX.EQ.1 ) THEN
-         DO 10 I = K1, K2
-            IP = IPIV( I )
-            IF( IP.NE.I )
-     $         CALL ZSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA )
-   10    CONTINUE
-      ELSE IF( INCX.GT.1 ) THEN
-         DO 20 I = K1, K2
+*
+      N32 = ( N / 32 )*32
+      IF( N32.NE.0 ) THEN
+         DO 30 J = 1, N32, 32
+            IX = IX0
+            DO 20 I = I1, I2, INC
+               IP = IPIV( IX )
+               IF( IP.NE.I ) THEN
+                  DO 10 K = J, J + 31
+                     TEMP = A( I, K )
+                     A( I, K ) = A( IP, K )
+                     A( IP, K ) = TEMP
+   10             CONTINUE
+               END IF
+               IX = IX + INCX
+   20       CONTINUE
+   30    CONTINUE
+      END IF
+      IF( N32.NE.N ) THEN
+         N32 = N32 + 1
+         IX = IX0
+         DO 50 I = I1, I2, INC
             IP = IPIV( IX )
-            IF( IP.NE.I )
-     $         CALL ZSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA )
+            IF( IP.NE.I ) THEN
+               DO 40 K = N32, N
+                  TEMP = A( I, K )
+                  A( I, K ) = A( IP, K )
+                  A( IP, K ) = TEMP
+   40          CONTINUE
+            END IF
             IX = IX + INCX
-   20    CONTINUE
-      ELSE IF( INCX.LT.0 ) THEN
-         DO 30 I = K2, K1, -1
-            IP = IPIV( IX )
-            IF( IP.NE.I )
-     $         CALL ZSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA )
-            IX = IX + INCX
-   30    CONTINUE
+   50    CONTINUE
       END IF
 *
       RETURN
diff --git a/libcruft/lapack/zlatrd.f b/libcruft/lapack/zlatrd.f
--- a/libcruft/lapack/zlatrd.f
+++ b/libcruft/lapack/zlatrd.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zlatrs.f b/libcruft/lapack/zlatrs.f
--- a/libcruft/lapack/zlatrs.f
+++ b/libcruft/lapack/zlatrs.f
@@ -1,7 +1,7 @@
       SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
      $                   CNORM, INFO )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     June 30, 1992
@@ -191,7 +191,7 @@
      $                   ZDOTU, ZLADIV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV
+      EXTERNAL           DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
diff --git a/libcruft/lapack/zpotf2.f b/libcruft/lapack/zpotf2.f
--- a/libcruft/lapack/zpotf2.f
+++ b/libcruft/lapack/zpotf2.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZPOTF2( UPLO, N, A, LDA, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zpotrf.f b/libcruft/lapack/zpotrf.f
--- a/libcruft/lapack/zpotrf.f
+++ b/libcruft/lapack/zpotrf.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZPOTRF( UPLO, N, A, LDA, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zrot.f b/libcruft/lapack/zrot.f
--- a/libcruft/lapack/zrot.f
+++ b/libcruft/lapack/zrot.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZROT( N, CX, INCX, CY, INCY, C, S )
 *
-*  -- LAPACK auxiliary routine (version 2.0) --
+*  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     October 31, 1992
diff --git a/libcruft/lapack/zsteqr.f b/libcruft/lapack/zsteqr.f
--- a/libcruft/lapack/zsteqr.f
+++ b/libcruft/lapack/zsteqr.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/ztrevc.f b/libcruft/lapack/ztrevc.f
--- a/libcruft/lapack/ztrevc.f
+++ b/libcruft/lapack/ztrevc.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
      $                   LDVR, MM, M, WORK, RWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          HOWMNY, SIDE
@@ -76,6 +76,9 @@
 *          Schur vectors returned by ZHSEQR).
 *          On exit, if SIDE = 'L' or 'B', VL contains:
 *          if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+*                           VL is lower triangular. The i-th column
+*                           VL(i) of VL is the eigenvector corresponding
+*                           to T(i,i).
 *          if HOWMNY = 'B', the matrix Q*Y;
 *          if HOWMNY = 'S', the left eigenvectors of T specified by
 *                           SELECT, stored consecutively in the columns
@@ -93,6 +96,9 @@
 *          Schur vectors returned by ZHSEQR).
 *          On exit, if SIDE = 'R' or 'B', VR contains:
 *          if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+*                           VR is upper triangular. The i-th column
+*                           VR(i) of VR is the eigenvector corresponding
+*                           to T(i,i).
 *          if HOWMNY = 'B', the matrix Q*X;
 *          if HOWMNY = 'S', the right eigenvectors of T specified by
 *                           SELECT, stored consecutively in the columns
@@ -154,7 +160,7 @@
       EXTERNAL           LSAME, IZAMAX, DLAMCH, DZASUM
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS
+      EXTERNAL           XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX
@@ -174,7 +180,7 @@
       LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
 *
       ALLV = LSAME( HOWMNY, 'A' )
-      OVER = LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'O' )
+      OVER = LSAME( HOWMNY, 'B' )
       SOMEV = LSAME( HOWMNY, 'S' )
 *
 *     Set M to the number of columns required to store the selected
diff --git a/libcruft/lapack/ztrexc.f b/libcruft/lapack/ztrexc.f
--- a/libcruft/lapack/ztrexc.f
+++ b/libcruft/lapack/ztrexc.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
diff --git a/libcruft/lapack/ztrsen.f b/libcruft/lapack/ztrsen.f
--- a/libcruft/lapack/ztrsen.f
+++ b/libcruft/lapack/ztrsen.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
      $                   SEP, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     March 31, 1993
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          COMPQ, JOB
@@ -71,7 +71,7 @@
 *          The leading dimension of the array Q.
 *          LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
 *
-*  W       (output) COMPLEX*16
+*  W       (output) COMPLEX*16 array, dimension (N)
 *          The reordered eigenvalues of T, in the same order as they
 *          appear on the diagonal of T.
 *
@@ -92,8 +92,9 @@
 *          M = 0 or N, SEP = norm(T).
 *          If JOB = 'N' or 'E', SEP is not referenced.
 *
-*  WORK    (workspace) COMPLEX*16 array, dimension (LWORK)
-*          If JOB = 'N', WORK is not referenced.
+*  WORK    (workspace/output) COMPLEX*16 array, dimension (LWORK)
+*          If JOB = 'N', WORK is not referenced.  Otherwise,
+*          on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *
 *  LWORK   (input) INTEGER
 *          The dimension of the array WORK.
@@ -101,6 +102,11 @@
 *          if JOB = 'E', LWORK = M*(N-M);
 *          if JOB = 'V' or 'B', LWORK >= 2*M*(N-M).
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -183,8 +189,8 @@
       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            WANTBH, WANTQ, WANTS, WANTSP
-      INTEGER            IERR, K, KASE, KS, N1, N2, NN
+      LOGICAL            LQUERY, WANTBH, WANTQ, WANTS, WANTSP
+      INTEGER            IERR, K, KASE, KS, LWMIN, N1, N2, NN
       DOUBLE PRECISION   EST, RNORM, SCALE
 *     ..
 *     .. Local Arrays ..
@@ -223,6 +229,16 @@
       NN = N1*N2
 *
       INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( WANTSP ) THEN
+         LWMIN = MAX( 1, 2*NN )
+      ELSE IF( LSAME( JOB, 'N' ) ) THEN
+         LWMIN = 1
+      ELSE IF( LSAME( JOB, 'E' ) ) THEN
+         LWMIN = MAX( 1, NN )
+      END IF
+*
       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.WANTS .AND. .NOT.WANTSP )
      $     THEN
          INFO = -1
@@ -234,13 +250,19 @@
          INFO = -6
       ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
          INFO = -8
-      ELSE IF( LWORK.LT.1 .OR. ( ( WANTS .AND. .NOT.WANTSP ) .AND.
-     $         LWORK.LT.NN ) .OR. ( WANTSP .AND. LWORK.LT.2*NN ) ) THEN
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
          INFO = -14
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 ) = LWMIN
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZTRSEN', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -326,6 +348,9 @@
       DO 50 K = 1, N
          W( K ) = T( K, K )
    50 CONTINUE
+*
+      WORK( 1 ) = LWMIN
+*
       RETURN
 *
 *     End of ZTRSEN
diff --git a/libcruft/lapack/ztrsyl.f b/libcruft/lapack/ztrsyl.f
--- a/libcruft/lapack/ztrsyl.f
+++ b/libcruft/lapack/ztrsyl.f
@@ -1,10 +1,10 @@
       SUBROUTINE ZTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
      $                   LDC, SCALE, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     March 31, 1993
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          TRANA, TRANB
@@ -102,11 +102,11 @@
 *     .. External Functions ..
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, ZLANGE
-      COMPLEX*16         ZDOTC, ZDOTU
-      EXTERNAL           LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU
+      COMPLEX*16         ZDOTC, ZDOTU, ZLADIV
+      EXTERNAL           LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU, ZLADIV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZDSCAL
+      EXTERNAL           XERBLA, ZDSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
@@ -196,7 +196,7 @@
                   IF( DB.GT.BIGNUM*DA11 )
      $               SCALOC = ONE / DB
                END IF
-               X11 = ( VEC*DCMPLX( SCALOC ) ) / A11
+               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
 *
                IF( SCALOC.NE.ONE ) THEN
                   DO 10 J = 1, N
@@ -244,7 +244,7 @@
      $               SCALOC = ONE / DB
                END IF
 *
-               X11 = ( VEC*DCMPLX( SCALOC ) ) / A11
+               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
 *
                IF( SCALOC.NE.ONE ) THEN
                   DO 40 J = 1, N
@@ -296,7 +296,7 @@
      $               SCALOC = ONE / DB
                END IF
 *
-               X11 = ( VEC*DCMPLX( SCALOC ) ) / A11
+               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
 *
                IF( SCALOC.NE.ONE ) THEN
                   DO 70 J = 1, N
@@ -346,7 +346,7 @@
      $               SCALOC = ONE / DB
                END IF
 *
-               X11 = ( VEC*DCMPLX( SCALOC ) ) / A11
+               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
 *
                IF( SCALOC.NE.ONE ) THEN
                   DO 100 J = 1, N
diff --git a/libcruft/lapack/zung2l.f b/libcruft/lapack/zung2l.f
--- a/libcruft/lapack/zung2l.f
+++ b/libcruft/lapack/zung2l.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zung2r.f b/libcruft/lapack/zung2r.f
--- a/libcruft/lapack/zung2r.f
+++ b/libcruft/lapack/zung2r.f
@@ -1,6 +1,6 @@
       SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zungbr.f b/libcruft/lapack/zungbr.f
--- a/libcruft/lapack/zungbr.f
+++ b/libcruft/lapack/zungbr.f
@@ -1,16 +1,16 @@
       SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          VECT
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -84,6 +84,11 @@
 *          For optimum performance LWORK >= min(M,N)*NB, where NB
 *          is the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -96,12 +101,13 @@
      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            WANTQ
-      INTEGER            I, IINFO, J
+      LOGICAL            LQUERY, WANTQ
+      INTEGER            I, IINFO, J, LWKOPT, MN, NB
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZUNGLQ, ZUNGQR
@@ -115,6 +121,8 @@
 *
       INFO = 0
       WANTQ = LSAME( VECT, 'Q' )
+      MN = MIN( M, N )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
          INFO = -1
       ELSE IF( M.LT.0 ) THEN
@@ -127,12 +135,25 @@
          INFO = -4
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -6
-      ELSE IF( LWORK.LT.MAX( 1, MIN( M, N ) ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
          INFO = -9
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( WANTQ ) THEN
+            NB = ILAENV( 1, 'ZUNGQR', ' ', M, N, K, -1 )
+         ELSE
+            NB = ILAENV( 1, 'ZUNGLQ', ' ', M, N, K, -1 )
+         END IF
+         LWKOPT = MAX( 1, MN )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNGBR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -217,6 +238,7 @@
             END IF
          END IF
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of ZUNGBR
diff --git a/libcruft/lapack/zunghr.f b/libcruft/lapack/zunghr.f
--- a/libcruft/lapack/zunghr.f
+++ b/libcruft/lapack/zunghr.f
@@ -1,15 +1,15 @@
       SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -54,6 +54,11 @@
 *          For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -66,11 +71,16 @@
      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IINFO, J, NH
+      LOGICAL            LQUERY
+      INTEGER            I, IINFO, J, LWKOPT, NB, NH
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZUNGQR
 *     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
@@ -79,6 +89,8 @@
 *     Test the input arguments
 *
       INFO = 0
+      NH = IHI - ILO
+      LQUERY = ( LWORK.EQ.-1 )
       IF( N.LT.0 ) THEN
          INFO = -1
       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
@@ -87,12 +99,21 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, IHI-ILO ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         NB = ILAENV( 1, 'ZUNGQR', ' ', NH, NH, NH, -1 )
+         LWKOPT = MAX( 1, NH )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNGHR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -130,7 +151,6 @@
          A( J, J ) = ONE
    80 CONTINUE
 *
-      NH = IHI - ILO
       IF( NH.GT.0 ) THEN
 *
 *        Generate Q(ilo+1:ihi,ilo+1:ihi)
@@ -138,6 +158,7 @@
          CALL ZUNGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
      $                WORK, LWORK, IINFO )
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of ZUNGHR
diff --git a/libcruft/lapack/zungl2.f b/libcruft/lapack/zungl2.f
--- a/libcruft/lapack/zungl2.f
+++ b/libcruft/lapack/zungl2.f
@@ -1,9 +1,9 @@
       SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, M, N
@@ -124,7 +124,7 @@
          END IF
          A( I, I ) = ONE - DCONJG( TAU( I ) )
 *
-*        Set A(1:i-1,i) to zero
+*        Set A(i,1:i-1) to zero
 *
          DO 30 L = 1, I - 1
             A( I, L ) = ZERO
diff --git a/libcruft/lapack/zunglq.f b/libcruft/lapack/zunglq.f
--- a/libcruft/lapack/zunglq.f
+++ b/libcruft/lapack/zunglq.f
@@ -1,15 +1,15 @@
       SUBROUTINE ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -57,6 +57,11 @@
 *          For optimum performance LWORK >= M*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit;
 *          < 0:  if INFO = -i, the i-th argument has an illegal value
@@ -68,8 +73,9 @@
       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK, NB,
-     $                   NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
+     $                   LWKOPT, NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNGL2
@@ -86,6 +92,10 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'ZUNGLQ', ' ', M, N, K, -1 )
+      LWKOPT = MAX( 1, M )*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.M ) THEN
@@ -94,12 +104,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, M ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNGLQ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -109,9 +121,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'ZUNGLQ', ' ', M, N, K, -1 )
       NBMIN = 2
       NX = 0
       IWS = M
diff --git a/libcruft/lapack/zungql.f b/libcruft/lapack/zungql.f
--- a/libcruft/lapack/zungql.f
+++ b/libcruft/lapack/zungql.f
@@ -1,15 +1,15 @@
       SUBROUTINE ZUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -58,6 +58,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument has an illegal value
@@ -69,8 +74,9 @@
       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, J, KK, L, LDWORK, NB, NBMIN,
-     $                   NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
+     $                   NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNG2L
@@ -87,6 +93,10 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'ZUNGQL', ' ', M, N, K, -1 )
+      LWKOPT = MAX( 1, N )*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
@@ -95,12 +105,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNGQL', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -110,9 +122,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'ZUNGQL', ' ', M, N, K, -1 )
       NBMIN = 2
       NX = 0
       IWS = N
diff --git a/libcruft/lapack/zungqr.f b/libcruft/lapack/zungqr.f
--- a/libcruft/lapack/zungqr.f
+++ b/libcruft/lapack/zungqr.f
@@ -1,15 +1,15 @@
       SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       INTEGER            INFO, K, LDA, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -58,6 +58,11 @@
 *          For optimum performance LWORK >= N*NB, where NB is the
 *          optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument has an illegal value
@@ -69,8 +74,9 @@
       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK, NB,
-     $                   NBMIN, NX
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
+     $                   LWKOPT, NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNG2R
@@ -87,6 +93,10 @@
 *     Test the input arguments
 *
       INFO = 0
+      NB = ILAENV( 1, 'ZUNGQR', ' ', M, N, K, -1 )
+      LWKOPT = MAX( 1, N )*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
@@ -95,12 +105,14 @@
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNGQR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -110,9 +122,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.
-*
-      NB = ILAENV( 1, 'ZUNGQR', ' ', M, N, K, -1 )
       NBMIN = 2
       NX = 0
       IWS = N
diff --git a/libcruft/lapack/zungtr.f b/libcruft/lapack/zungtr.f
--- a/libcruft/lapack/zungtr.f
+++ b/libcruft/lapack/zungtr.f
@@ -1,16 +1,16 @@
       SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
       INTEGER            INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -56,6 +56,11 @@
 *          For optimum performance LWORK >= (N-1)*NB, where NB is
 *          the optimal blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -68,12 +73,13 @@
      $                   ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            I, IINFO, J
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, J, LWKOPT, NB
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZUNGQL, ZUNGQR
@@ -86,6 +92,7 @@
 *     Test the input arguments
 *
       INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
       UPPER = LSAME( UPLO, 'U' )
       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
@@ -93,12 +100,25 @@
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, N-1 ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( UPPER ) THEN
+            NB = ILAENV( 1, 'ZUNGQL', ' ', N-1, N-1, N-1, -1 )
+         ELSE
+            NB = ILAENV( 1, 'ZUNGQR', ' ', N-1, N-1, N-1, -1 )
+         END IF
+         LWKOPT = MAX( 1, N-1 )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNGTR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -157,6 +177,7 @@
      $                   LWORK, IINFO )
          END IF
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of ZUNGTR
diff --git a/libcruft/lapack/zunm2r.f b/libcruft/lapack/zunm2r.f
--- a/libcruft/lapack/zunm2r.f
+++ b/libcruft/lapack/zunm2r.f
@@ -1,7 +1,7 @@
       SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zunmbr.f b/libcruft/lapack/zunmbr.f
--- a/libcruft/lapack/zunmbr.f
+++ b/libcruft/lapack/zunmbr.f
@@ -1,18 +1,17 @@
       SUBROUTINE ZUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
      $                   LDC, WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          SIDE, TRANS, VECT
       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ),
-     $                   WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -110,6 +109,11 @@
 *          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
 *          blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -117,13 +121,14 @@
 *  =====================================================================
 *
 *     .. Local Scalars ..
-      LOGICAL            APPLYQ, LEFT, NOTRAN
+      LOGICAL            APPLYQ, LEFT, LQUERY, NOTRAN
       CHARACTER          TRANST
-      INTEGER            I1, I2, IINFO, MI, NI, NQ, NW
+      INTEGER            I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZUNMLQ, ZUNMQR
@@ -139,6 +144,7 @@
       APPLYQ = LSAME( VECT, 'Q' )
       LEFT = LSAME( SIDE, 'L' )
       NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
 *     NQ is the order of Q or P and NW is the minimum dimension of WORK
 *
@@ -167,12 +173,36 @@
          INFO = -8
       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
          INFO = -11
-      ELSE IF( LWORK.LT.MAX( 1, NW ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
          INFO = -13
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( APPLYQ ) THEN
+            IF( LEFT ) THEN
+               NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N, M-1,
+     $              -1 )
+            ELSE
+               NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1, N-1,
+     $              -1 )
+            END IF
+         ELSE
+            IF( LEFT ) THEN
+               NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M-1, N, M-1,
+     $              -1 )
+            ELSE
+               NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N-1, N-1,
+     $              -1 )
+            END IF
+         END IF
+         LWKOPT = MAX( 1, NW )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNMBR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
       END IF
 *
 *     Quick return if possible
@@ -243,6 +273,7 @@
      $                   TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
          END IF
       END IF
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of ZUNMBR
diff --git a/libcruft/lapack/zunml2.f b/libcruft/lapack/zunml2.f
--- a/libcruft/lapack/zunml2.f
+++ b/libcruft/lapack/zunml2.f
@@ -1,7 +1,7 @@
       SUBROUTINE ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     September 30, 1994
diff --git a/libcruft/lapack/zunmlq.f b/libcruft/lapack/zunmlq.f
--- a/libcruft/lapack/zunmlq.f
+++ b/libcruft/lapack/zunmlq.f
@@ -1,18 +1,17 @@
       SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          SIDE, TRANS
       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ),
-     $                   WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -88,6 +87,11 @@
 *          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
 *          blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -99,10 +103,10 @@
       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
+      LOGICAL            LEFT, LQUERY, NOTRAN
       CHARACTER          TRANST
       INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   MI, NB, NBMIN, NI, NQ, NW
+     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
 *     ..
 *     .. Local Arrays ..
       COMPLEX*16         T( LDT, NBMAX )
@@ -125,6 +129,7 @@
       INFO = 0
       LEFT = LSAME( SIDE, 'L' )
       NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
 *     NQ is the order of Q and NW is the minimum dimension of WORK
 *
@@ -149,12 +154,26 @@
          INFO = -7
       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
          INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
          INFO = -12
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size.  NB may be at most NBMAX, where NBMAX
+*        is used to define the local array T.
+*
+         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N, K,
+     $        -1 ) )
+         LWKOPT = MAX( 1, NW )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNMLQ', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -164,11 +183,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.  NB may be at most NBMAX, where NBMAX
-*     is used to define the local array T.
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N, K,
-     $     -1 ) )
       NBMIN = 2
       LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN
@@ -246,7 +260,7 @@
      $                   LDWORK )
    10    CONTINUE
       END IF
-      WORK( 1 ) = IWS
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of ZUNMLQ
diff --git a/libcruft/lapack/zunmqr.f b/libcruft/lapack/zunmqr.f
--- a/libcruft/lapack/zunmqr.f
+++ b/libcruft/lapack/zunmqr.f
@@ -1,18 +1,17 @@
       SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
      $                   WORK, LWORK, INFO )
 *
-*  -- LAPACK routine (version 2.0) --
+*  -- LAPACK routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*     June 30, 1999
 *
 *     .. Scalar Arguments ..
       CHARACTER          SIDE, TRANS
       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ),
-     $                   WORK( LWORK )
+      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
 *     ..
 *
 *  Purpose
@@ -88,6 +87,11 @@
 *          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
 *          blocksize.
 *
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
 *  INFO    (output) INTEGER
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
@@ -99,9 +103,9 @@
       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
+      LOGICAL            LEFT, LQUERY, NOTRAN
       INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   MI, NB, NBMIN, NI, NQ, NW
+     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
 *     ..
 *     .. Local Arrays ..
       COMPLEX*16         T( LDT, NBMAX )
@@ -124,6 +128,7 @@
       INFO = 0
       LEFT = LSAME( SIDE, 'L' )
       NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
 *
 *     NQ is the order of Q and NW is the minimum dimension of WORK
 *
@@ -148,12 +153,26 @@
          INFO = -7
       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
          INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
          INFO = -12
       END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size.  NB may be at most NBMAX, where NBMAX
+*        is used to define the local array T.
+*
+         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, K,
+     $        -1 ) )
+         LWKOPT = MAX( 1, NW )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZUNMQR', -INFO )
          RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
       END IF
 *
 *     Quick return if possible
@@ -163,11 +182,6 @@
          RETURN
       END IF
 *
-*     Determine the block size.  NB may be at most NBMAX, where NBMAX
-*     is used to define the local array T.
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, K,
-     $     -1 ) )
       NBMIN = 2
       LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN
@@ -239,7 +253,7 @@
      $                   WORK, LDWORK )
    10    CONTINUE
       END IF
-      WORK( 1 ) = IWS
+      WORK( 1 ) = LWKOPT
       RETURN
 *
 *     End of ZUNMQR
diff --git a/liboctave/ChangeLog b/liboctave/ChangeLog
--- a/liboctave/ChangeLog
+++ b/liboctave/ChangeLog
@@ -1,3 +1,9 @@
+1999-11-02  John W. Eaton  <jwe@bevo.che.wisc.edu>
+
+	* DiagArray2.cc (DiagArray2<T>::operator () (int, int)):
+	On errors, simply return `T ()'.
+	(DiagArray2<T>::checkelem (int, int)): Likewise.
+
 1999-11-02  A. Scottedward Hodel <a.s.hodel@eng.auburn.edu>
 
 	* dMatrix.cc (Matrix::expm): Do balancing here instead of using
diff --git a/liboctave/DiagArray2.cc b/liboctave/DiagArray2.cc
--- a/liboctave/DiagArray2.cc
+++ b/liboctave/DiagArray2.cc
@@ -89,9 +89,7 @@
   if (r < 0 || c < 0 || r >= nr || c >= nc)
     {
       (*current_liboctave_error_handler) ("range error");
-      T foo;
-      static T *bar = &foo;
-      return foo;
+      return T ();
     }
   return (r == c) ? Array<T>::xelem (r) : T (0);
 }
@@ -103,9 +101,7 @@
   if (r < 0 || c < 0 || r >= nr || c >= nc)
     {
       (*current_liboctave_error_handler) ("range error");
-      T foo;
-      static T *bar = &foo;
-      return foo;
+      return T ();
     }
   return (r == c) ? Array<T>::xelem (r) : T (0);
 }
diff --git a/src/data.cc b/src/data.cc
--- a/src/data.cc
+++ b/src/data.cc
@@ -800,8 +800,7 @@
   "-*- texinfo -*-\n\
 @deftypefn {Usage} {} is_matrix (@var{a})\n\
 Return 1 if @var{a} is a matrix.  Otherwise, return 0.\n\
-@end deftypefn\n\
-")
+@end deftypefn")
 {
   double retval = 0.0;
 
diff --git a/src/defaults.cc b/src/defaults.cc
--- a/src/defaults.cc
+++ b/src/defaults.cc
@@ -464,6 +464,7 @@
 @defvr\n\
 The version number of Octave, as a string.\n\
 @end defvr");
+
 }
 
 DEFUN (rehash, , ,
diff --git a/src/help.cc b/src/help.cc
--- a/src/help.cc
+++ b/src/help.cc
@@ -843,8 +843,7 @@
 \n\
 Once the GNU Info browser is running, help for using it is available\n\
 using the command @kbd{C-h}.\n\
-@end deffn\n\
-")
+@end deffn")
 {
   octave_value_list retval;
 
@@ -1194,8 +1193,7 @@
 The variable @code{INFO_FILE} names the location of the Octave info file.\n\
 The default value is @code{\"@var{octave-home}/info/octave.info\"}, where\n\
 @var{octave-home} is the directory where all of Octave is installed.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (INFO_PROGRAM, Vinfo_prog, info_prog,
     "-*- texinfo -*-\n\
@@ -1203,8 +1201,7 @@
 The variable @code{INFO_FILE} names the location of the Octave info file.\n\
 The default value is @code{\"@var{octave-home}/info/octave.info\"}, where\n\
 @var{octave-home} is the directory where all of Octave is installed.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (suppress_verbose_help_message, 0.0, suppress_verbose_help_message,
     "-*- texinfo -*-\n\
@@ -1212,8 +1209,8 @@
 If the value of @code{suppress_verbose_help_message} is nonzero, Octave\n\
 will not add additional help information to the end of the output from\n\
 the @code{help} command and usage messages for built-in commands.\n\
-@end defvr\n\
-");
+@end defvr");
+
 }
 
 /*
diff --git a/src/input.cc b/src/input.cc
--- a/src/input.cc
+++ b/src/input.cc
@@ -671,8 +671,7 @@
 @noindent\n\
 If invoked without any arguments, @code{echo} toggles the current echo\n\
 state.\n\
-@end deffn\n\
-")
+@end deffn")
 {
   octave_value_list retval;
 
@@ -747,8 +746,7 @@
 might be controlling Octave and handling user input.  The current\n\
 command number is not incremented when this function is called.  This is\n\
 a feature, not a bug.\n\
-@end deftypefn\n\
-")
+@end deftypefn")
 {
   octave_value retval;
 
@@ -923,8 +921,7 @@
 @samp{boris} logged in on the host @samp{kremvax.kgb.su}.  Note that two\n\
 backslashes are required to enter a backslash into a string.\n\
 @xref{Strings}.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (PS2, "> ", ps2,
     "-*- texinfo -*-\n\
@@ -934,18 +931,16 @@
 defining a function over several lines, Octave will print the value of\n\
 @code{PS1} at the beginning of each line after the first.  The default\n\
 value of @code{PS2} is @code{\"> \"}.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (PS4, "+ ", ps4,
     "-*- texinfo -*-\n\
 @defvr {Built-in Variable} PS4\n\
 If Octave is invoked with the @code{--echo-input} option, the value of\n\
 @code{PS4} is printed before each line of input that is echoed.  The\n\
-default value of @code{PS4} is @code{"+ "}.  @xref{Invoking Octave}, for\n\
+default value of @code{PS4} is @code{\"+ \"}.  @xref{Invoking Octave}, for\n\
 a description of @code{--echo-input}.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (completion_append_char, " ", completion_append_char,
     "-*- texinfo -*-\n\
@@ -953,8 +948,7 @@
 The value of @code{completion_append_char} is used as the character to\n\
 append to successful command-line completion attempts.  The default\n\
 value is @code{\" \"} (a single space).\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (echo_executing_commands, static_cast<double> (ECHO_OFF),
 	  echo_executing_commands,
@@ -979,8 +973,8 @@
 \n\
 The value of @code{echo_executing_commands} is set by the @kbd{echo}\n\
 command and the command line option @code{--echo-input}.\n\
-@end defvr\n\
-");
+@end defvr");
+
 }
 
 /*
diff --git a/src/oct-hist.cc b/src/oct-hist.cc
--- a/src/oct-hist.cc
+++ b/src/oct-hist.cc
@@ -567,8 +567,7 @@
 the first command than the last command reverses the list of commands\n\
 before placing them in the buffer to be edited.  If both arguments are\n\
 omitted, the previous command in the history list is used.\n\
-@end deffn\n\
-")
+@end deffn")
 {
   octave_value_list retval;
 
@@ -611,8 +610,7 @@
 For example, to display the five most recent commands that you have\n\
 typed without displaying line numbers, use the command\n\
 @kbd{history -q 5}.\n\
-@end deffn\n\
-")
+@end deffn")
 {
   octave_value_list retval;
 
@@ -633,8 +631,7 @@
 @deffn {Command} run_history [first] [last]\n\
 Similar to @code{edit_history}, except that the editor is not invoked,\n\
 and the commands are simply executed as they appear in the history list.\n\
-@end deffn\n\
-")
+@end deffn")
 {
   octave_value_list retval;
 
@@ -709,8 +706,7 @@
 This variable specifies the name of the file used to store command\n\
 history.  The default value is @code{\"~/.octave_hist\"}, but may be\n\
 overridden by the environment variable @code{OCTAVE_HISTFILE}.\n\
-@end defvr\n\
-");
+@end defvr");
 
   double tmp_hist_size = default_history_size ();
 
@@ -720,8 +716,7 @@
 This variable specifies how many entries to store in the history file.\n\
 The default value is @code{1024}, but may be overridden by the\n\
 environment variable @code{OCTAVE_HISTSIZE}.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (saving_history, 1.0, saving_history,
     "-*- texinfo -*-\n\
@@ -729,8 +724,8 @@
 If the value of @code{saving_history} is nonzero, command entered\n\
 on the command line are saved in the file specified by the variable\n\
 @code{history_file}.\n\
-@end defvr\n\
-");
+@end defvr");
+
 }
 
 /*
diff --git a/src/ov.cc b/src/ov.cc
--- a/src/ov.cc
+++ b/src/ov.cc
@@ -1524,8 +1524,7 @@
 If the value of @code{propagate_empty_matrices} is nonzero,\n\
 functions like @code{inverse} and @code{svd} will return an empty matrix\n\
 if they are given one as an argument.  The default value is 1.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (resize_on_range_error, 1.0, resize_on_range_error,
     "enlarge matrices on assignment");
diff --git a/src/pager.cc b/src/pager.cc
--- a/src/pager.cc
+++ b/src/pager.cc
@@ -376,8 +376,7 @@
 @end table\n\
 \n\
 Without any arguments, @code{diary} toggles the current diary state.\n\
-@end deffn\n\
-")
+@end deffn")
 {
   octave_value_list retval;
 
diff --git a/src/pr-output.cc b/src/pr-output.cc
--- a/src/pr-output.cc
+++ b/src/pr-output.cc
@@ -1917,24 +1917,21 @@
 @code{fixed_point_format} to a nonzero value.\n\
 \n\
 The default value of @code{fixed_point_format} is 0.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (output_max_field_width, 10.0, output_max_field_width,
     "-*- texinfo -*-\n\
 @defvr {Built-in Variable} output_max_field_width\n\
 This variable specifies the maximum width of a numeric output field.\n\
 The default value is 10.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (output_precision, 5.0, output_precision,
     "-*- texinfo -*-\n\
 @defvr {Built-in Variable} output_precision\n\
 This variable specifies the minimum number of significant figures to\n\
 display for numeric output.  The default value is 5.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (print_empty_dimensions, 1.0, print_empty_dimensions,
     "-*- texinfo -*-\n\
@@ -1953,8 +1950,7 @@
 @example\n\
 ans = [](3x0)\n\
 @end example\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFVAR (split_long_rows, 1.0, split_long_rows,
     "-*- texinfo -*-\n\
@@ -1989,8 +1985,8 @@
 \n\
 @noindent\n\
 The default value of @code{split_long_rows} is nonzero.\n\
-@end defvr\n\
-");
+@end defvr");
+
 }
 
 /*
diff --git a/src/pt-mat.cc b/src/pt-mat.cc
--- a/src/pt-mat.cc
+++ b/src/pt-mat.cc
@@ -626,8 +626,8 @@
 and the variable @code{a} will be assigned the value @code{[ 1, 3, 5 ]}.\n\
 \n\
 The default value is @code{\"warn\"}.\n\
-@end defvr\n\
-");
+@end defvr");
+
   DEFVAR (implicit_num_to_str_ok, 0.0, implicit_num_to_str_ok,
     "make the result of things like `[97, 98, 99, \"123\"]' be a string");
 
diff --git a/src/sysdep.cc b/src/sysdep.cc
--- a/src/sysdep.cc
+++ b/src/sysdep.cc
@@ -120,7 +120,7 @@
 {
   malloc_error (malloc_handler);
 }
-endif
+#endif
 
 #if defined (__EMX__)
 OS2_init (void)
@@ -324,8 +324,7 @@
 @deftypefn {Built-in Function} {} clc ()\n\
 @deftypefnx {Built-in Function} {} home ()\n\
 Clear the terminal screen and move the cursor to the upper left corner.\n\
-@end deftypefn\n\
-")
+@end deftypefn")
 {
   command_editor::clear_screen ();
 
diff --git a/src/toplev.cc b/src/toplev.cc
--- a/src/toplev.cc
+++ b/src/toplev.cc
@@ -242,8 +242,7 @@
 Exit the current Octave session.  If the optional integer value\n\
 @var{status} is supplied, pass that value to the operating system as the\n\
 Octave's exit status.\n\
-@end deftypefn\n\
-")
+@end deftypefn")
 {
   octave_value_list retval;
 
@@ -553,8 +552,7 @@
 \n\
 @noindent\n\
 will print a message when Octave exits.\n\
-@end deftypefn\n\
-")
+@end deftypefn")
 {
   octave_value_list retval;
 
@@ -723,8 +721,7 @@
 \n\
 If you write an executable Octave script, @code{argv} will contain the\n\
 list of arguments passed to the script.  @pxref{Executable Octave Programs}.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFCONST (program_invocation_name,
 	    octave_env::get_program_invocation_name (),
@@ -745,8 +742,7 @@
 or using an executable Octave script, the program name is set to the\n\
 name of the script.  @xref{Executable Octave Programs} for an example of\n\
 how to create an executable Octave script.\n\
-@end defvr\n\
-");
+@end defvr");
 
   DEFCONST (program_name, octave_env::get_program_name (),
     "-*- texinfo -*-\n\
@@ -766,8 +762,8 @@
 or using an executable Octave script, the program name is set to the\n\
 name of the script.  @xref{Executable Octave Programs} for an example of\n\
 how to create an executable Octave script.\n\
-@end defvr\n\
-");
+@end defvr");
+
 }
 
 /*