Routine: DDTTRSV()  File: SRC\ddttrsv.f

 
 
# lines: 174
  # code: 174
  # comment: 0
  # blank:0
# Variables:12
# Callers:1
# Callings:0
# Words:89
# Keywords:66
 

 

 
..
     .. Array Arguments ..
     ..
  Purpose
  =======
  DDTTRSV solves one of the systems of equations
     L * X = B,  L**T * X = B,  or  L**H * X = B,
     U * X = B,  U**T * X = B,  or  U**H * X = B,
  with factors of the tridiagonal matrix A from the LU factorization
  computed by DDTTRF.
  Arguments
  =========
  UPLO    (input) CHARACTER*1
          Specifies whether to solve with L or U.
  TRANS   (input) CHARACTER
          Specifies the form of the system of equations:
          = 'N':  A * X = B     (No transpose)
          = 'T':  A**T * X = B  (Transpose)
          = 'C':  A**H * X = B  (Conjugate transpose)
  N       (input) INTEGER
          The order of the matrix A.  N >= 0.
  NRHS    (input) INTEGER
          The number of right hand sides, i.e., the number of columns
          of the matrix B.  NRHS >= 0.
  DL      (input) COMPLEX array, dimension (N-1)
          The (n-1) multipliers that define the matrix L from the
          LU factorization of A.
  D       (input) COMPLEX array, dimension (N)
          The n diagonal elements of the upper triangular matrix U from
          the LU factorization of A.
  DU      (input) COMPLEX array, dimension (N-1)
          The (n-1) elements of the first superdiagonal of U.
  B       (input/output) COMPLEX array, dimension (LDB,NRHS)
          On entry, the right hand side matrix B.
          On exit, B is overwritten by the solution matrix X.
  LDB     (input) INTEGER
          The leading dimension of the array B.  LDB >= max(1,N).
  INFO    (output) INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
  =====================================================================
     .. Local Scalars ..
 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

  
001        SUBROUTINE DDTTRSV( UPLO , TRANS , N , NRHS , DL , D , DU ,
002       $B , LDB , INFO )
003  
004  *     Written by Andrew J. Cleary , University of Tennessee.
005  *     August , 1996.
006  *     Modified from DGTTRS :
007  *     -- LAPACK routine(preliminary version) --
008  *     Univ. of Tennessee , Univ. of California Berkeley , NAG Ltd. ,
009  *     Courant Institute , Argonne National Lab , and Rice University
010  
011  *     .. Scalar Arguments ..
012        CHARACTER UPLO , TRANS
013        INTEGER INFO , LDB , N , NRHS
014        LOGICAL LOWER , NOTRAN
015        INTEGER I , J
016  *     ..
017  *     .. External Functions ..
018        LOGICAL LSAME
019        EXTERNAL LSAME
020  *     ..
021  *     .. External Subroutines ..
022        EXTERNAL XERBLA
023  *     ..
024  *     .. Intrinsic Functions ..
025        INTRINSIC CONJG , MAX
026  *     ..
027  *     .. Executable Statements ..
028  
029        INFO = 0
030        NOTRAN = LSAME( TRANS , 'N' )
031        LOWER = LSAME( UPLO , 'L' )
032        IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO , 'U' ) ) THEN
033            INFO = - 1
034        ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS , 'T' ) .AND. .NOT.
035       $    LSAME( TRANS , 'C' ) ) THEN
036            INFO = - 2
037        ELSE IF( N.LT.0 ) THEN
038            INFO = - 3
039        ELSE IF( NRHS.LT.0 ) THEN
040            INFO = - 4
041        ELSE IF( LDB.LT.MAX( N , 1 ) ) THEN
042            INFO = - 9
043        END IF
044        IF( INFO.NE.0 ) THEN
045            CALL XERBLA( 'DDTTRSV' , - INFO )
046            RETURN
047        END IF
048  
049  *     Quick return if possible
050  
051        IF( N.EQ.0 .OR. NRHS.EQ.0 )
052       $    RETURN
053  
054            IF( NOTRAN ) THEN
055  
056                IF( LOWER ) THEN
057  *                 Solve L*X = B , overwriting B with X.
058  
059                    DO 35 J = 1 , NRHS
060  
061  *                     Solve L*x = b.
062  
063                        DO 10 I = 1 , N - 1
064                            B( I + 1 , J ) = B( I + 1 , J ) - DL( I )*B( I , J )
065     10                 CONTINUE
066     35             CONTINUE
067  
068                ELSE
069  *                 Solve U*x = b.
070  
071                    DO 30 J = 1 , NRHS
072                        B( N , J ) = B( N , J ) / D( N )
073                        IF( N.GT.1 )
074       $                    B( N - 1 , J ) =( B( N - 1 , J ) - DU( N - 1 )*B( N , J ) ) /
075       $                    D( N - 1 )
076                            DO 20 I = N - 2 , 1 , - 1
077                                B( I , J ) =( B( I , J ) - DU( I )*B( I + 1 , J ) ) / D( I )
078     20                     CONTINUE
079     30             CONTINUE
080  
081                ENDIF
082  
083            ELSE
084  
085                IF( .NOT. LOWER ) THEN
086  *                 Solve U**T * X = B , overwriting B with X.
087  
088                    DO 65 J = 1 , NRHS
089  
090  *                     Solve U**T * x = b.
091  
092                        B( 1 , J ) = B( 1 , J ) / D( 1 )
093                        IF( N.GT.1 )
094       $                    B( 2 , J ) =( B( 2 , J ) - DU( 1 )*B( 1 , J ) ) / D( 2 )
095                            DO 40 I = 3 , N
096                                B( I , J ) =( B( I , J ) - DU( I - 1 )*B( I - 1 , J ) ) / D( I )
097     40                     CONTINUE
098     65             CONTINUE
099  
100                ELSE
101  
102  *                 Solve L**T * X = B , overwriting B with X.
103                    DO 60 J = 1 , NRHS
104  
105  *                     Solve L**T * x = b.
106  
107                        DO 50 I = N - 1 , 1 , - 1
108                            B( I , J ) = B( I , J ) - DL( I )*B( I + 1 , J )
109     50                 CONTINUE
110     60             CONTINUE
111                ENDIF
112            END IF
113  
114  *         End of DDTTRSV
115  
116        END