diff libcruft/lapack/dgttrs.f @ 7034:68db500cb558

[project @ 2007-10-16 18:54:19 by jwe]
author jwe
date Tue, 16 Oct 2007 18:54:23 +0000
parents 57077d0ddc8e
children
line wrap: on
line diff
--- a/libcruft/lapack/dgttrs.f	Tue Oct 16 17:46:44 2007 +0000
+++ b/libcruft/lapack/dgttrs.f	Tue Oct 16 18:54:23 2007 +0000
@@ -1,10 +1,9 @@
       SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
      $                   INFO )
 *
-*  -- LAPACK routine (version 2.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
+*  -- LAPACK routine (version 3.1) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2006
 *
 *     .. Scalar Arguments ..
       CHARACTER          TRANS
@@ -26,14 +25,14 @@
 *  Arguments
 *  =========
 *
-*  TRANS   (input) CHARACTER
-*          Specifies the form of the system of equations:
+*  TRANS   (input) CHARACTER*1
+*          Specifies the form of the system of equations.
 *          = 'N':  A * X = B  (No transpose)
 *          = 'T':  A'* X = B  (Transpose)
 *          = 'C':  A'* X = B  (Conjugate transpose = Transpose)
 *
 *  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
+*          The order of the matrix A.
 *
 *  NRHS    (input) INTEGER
 *          The number of right hand sides, i.e., the number of columns
@@ -48,10 +47,10 @@
 *          the LU factorization of A.
 *
 *  DU      (input) DOUBLE PRECISION array, dimension (N-1)
-*          The (n-1) elements of the first superdiagonal of U.
+*          The (n-1) elements of the first super-diagonal of U.
 *
 *  DU2     (input) DOUBLE PRECISION array, dimension (N-2)
-*          The (n-2) elements of the second superdiagonal of U.
+*          The (n-2) elements of the second super-diagonal of U.
 *
 *  IPIV    (input) INTEGER array, dimension (N)
 *          The pivot indices; for 1 <= i <= n, row i of the matrix was
@@ -60,8 +59,8 @@
 *          required.
 *
 *  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the right hand side matrix B.
-*          On exit, B is overwritten by the solution matrix X.
+*          On entry, the matrix of right hand side vectors B.
+*          On exit, B is overwritten by the solution vectors X.
 *
 *  LDB     (input) INTEGER
 *          The leading dimension of the array B.  LDB >= max(1,N).
@@ -74,25 +73,24 @@
 *
 *     .. Local Scalars ..
       LOGICAL            NOTRAN
-      INTEGER            I, J
-      DOUBLE PRECISION   TEMP
+      INTEGER            ITRANS, J, JB, NB
 *     ..
 *     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA
+      EXTERNAL           DGTTS2, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          MAX
+      INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
 *
       INFO = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
-     $    LSAME( TRANS, 'C' ) ) THEN
+      NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
+      IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
+     $    't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
@@ -111,64 +109,30 @@
       IF( N.EQ.0 .OR. NRHS.EQ.0 )
      $   RETURN
 *
-      IF( NOTRAN ) THEN
-*
-*        Solve A*X = B using the LU factorization of A,
-*        overwriting each right hand side vector with its solution.
-*
-         DO 30 J = 1, NRHS
-*
-*           Solve L*x = b.
+*     Decode TRANS
 *
-            DO 10 I = 1, N - 1
-               IF( IPIV( I ).EQ.I ) THEN
-                  B( I+1, J ) = B( I+1, J ) - DL( I )*B( I, J )
-               ELSE
-                  TEMP = B( I, J )
-                  B( I, J ) = B( I+1, J )
-                  B( I+1, J ) = TEMP - DL( I )*B( I, J )
-               END IF
-   10       CONTINUE
+      IF( NOTRAN ) THEN
+         ITRANS = 0
+      ELSE
+         ITRANS = 1
+      END IF
 *
-*           Solve U*x = b.
+*     Determine the number of right-hand sides to solve at a time.
 *
-            B( N, J ) = B( N, J ) / D( N )
-            IF( N.GT.1 )
-     $         B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
-     $                       D( N-1 )
-            DO 20 I = N - 2, 1, -1
-               B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
-     $                     B( I+2, J ) ) / D( I )
-   20       CONTINUE
-   30    CONTINUE
+      IF( NRHS.EQ.1 ) THEN
+         NB = 1
       ELSE
-*
-*        Solve A' * X = B.
-*
-         DO 60 J = 1, NRHS
-*
-*           Solve U'*x = b.
+         NB = MAX( 1, ILAENV( 1, 'DGTTRS', TRANS, N, NRHS, -1, -1 ) )
+      END IF
 *
-            B( 1, J ) = B( 1, J ) / D( 1 )
-            IF( N.GT.1 )
-     $         B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
-            DO 40 I = 3, N
-               B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
-     $                     B( I-2, J ) ) / D( I )
-   40       CONTINUE
-*
-*           Solve L'*x = b.
-*
-            DO 50 I = N - 1, 1, -1
-               IF( IPIV( I ).EQ.I ) THEN
-                  B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
-               ELSE
-                  TEMP = B( I+1, J )
-                  B( I+1, J ) = B( I, J ) - DL( I )*TEMP
-                  B( I, J ) = TEMP
-               END IF
-   50       CONTINUE
-   60    CONTINUE
+      IF( NB.GE.NRHS ) THEN
+         CALL DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
+      ELSE
+         DO 10 J = 1, NRHS, NB
+            JB = MIN( NRHS-J+1, NB )
+            CALL DGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
+     $                   LDB )
+   10    CONTINUE
       END IF
 *
 *     End of DGTTRS