LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dgttrf.f
Go to the documentation of this file.
00001 *> \brief \b DGTTRF
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DGTTRF + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgttrf.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgttrf.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgttrf.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            INFO, N
00025 *       ..
00026 *       .. Array Arguments ..
00027 *       INTEGER            IPIV( * )
00028 *       DOUBLE PRECISION   D( * ), DL( * ), DU( * ), DU2( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> DGTTRF computes an LU factorization of a real tridiagonal matrix A
00038 *> using elimination with partial pivoting and row interchanges.
00039 *>
00040 *> The factorization has the form
00041 *>    A = L * U
00042 *> where L is a product of permutation and unit lower bidiagonal
00043 *> matrices and U is upper triangular with nonzeros in only the main
00044 *> diagonal and first two superdiagonals.
00045 *> \endverbatim
00046 *
00047 *  Arguments:
00048 *  ==========
00049 *
00050 *> \param[in] N
00051 *> \verbatim
00052 *>          N is INTEGER
00053 *>          The order of the matrix A.
00054 *> \endverbatim
00055 *>
00056 *> \param[in,out] DL
00057 *> \verbatim
00058 *>          DL is DOUBLE PRECISION array, dimension (N-1)
00059 *>          On entry, DL must contain the (n-1) sub-diagonal elements of
00060 *>          A.
00061 *>
00062 *>          On exit, DL is overwritten by the (n-1) multipliers that
00063 *>          define the matrix L from the LU factorization of A.
00064 *> \endverbatim
00065 *>
00066 *> \param[in,out] D
00067 *> \verbatim
00068 *>          D is DOUBLE PRECISION array, dimension (N)
00069 *>          On entry, D must contain the diagonal elements of A.
00070 *>
00071 *>          On exit, D is overwritten by the n diagonal elements of the
00072 *>          upper triangular matrix U from the LU factorization of A.
00073 *> \endverbatim
00074 *>
00075 *> \param[in,out] DU
00076 *> \verbatim
00077 *>          DU is DOUBLE PRECISION array, dimension (N-1)
00078 *>          On entry, DU must contain the (n-1) super-diagonal elements
00079 *>          of A.
00080 *>
00081 *>          On exit, DU is overwritten by the (n-1) elements of the first
00082 *>          super-diagonal of U.
00083 *> \endverbatim
00084 *>
00085 *> \param[out] DU2
00086 *> \verbatim
00087 *>          DU2 is DOUBLE PRECISION array, dimension (N-2)
00088 *>          On exit, DU2 is overwritten by the (n-2) elements of the
00089 *>          second super-diagonal of U.
00090 *> \endverbatim
00091 *>
00092 *> \param[out] IPIV
00093 *> \verbatim
00094 *>          IPIV is INTEGER array, dimension (N)
00095 *>          The pivot indices; for 1 <= i <= n, row i of the matrix was
00096 *>          interchanged with row IPIV(i).  IPIV(i) will always be either
00097 *>          i or i+1; IPIV(i) = i indicates a row interchange was not
00098 *>          required.
00099 *> \endverbatim
00100 *>
00101 *> \param[out] INFO
00102 *> \verbatim
00103 *>          INFO is INTEGER
00104 *>          = 0:  successful exit
00105 *>          < 0:  if INFO = -k, the k-th argument had an illegal value
00106 *>          > 0:  if INFO = k, U(k,k) is exactly zero. The factorization
00107 *>                has been completed, but the factor U is exactly
00108 *>                singular, and division by zero will occur if it is used
00109 *>                to solve a system of equations.
00110 *> \endverbatim
00111 *
00112 *  Authors:
00113 *  ========
00114 *
00115 *> \author Univ. of Tennessee 
00116 *> \author Univ. of California Berkeley 
00117 *> \author Univ. of Colorado Denver 
00118 *> \author NAG Ltd. 
00119 *
00120 *> \date November 2011
00121 *
00122 *> \ingroup doubleOTHERcomputational
00123 *
00124 *  =====================================================================
00125       SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
00126 *
00127 *  -- LAPACK computational routine (version 3.4.0) --
00128 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00129 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00130 *     November 2011
00131 *
00132 *     .. Scalar Arguments ..
00133       INTEGER            INFO, N
00134 *     ..
00135 *     .. Array Arguments ..
00136       INTEGER            IPIV( * )
00137       DOUBLE PRECISION   D( * ), DL( * ), DU( * ), DU2( * )
00138 *     ..
00139 *
00140 *  =====================================================================
00141 *
00142 *     .. Parameters ..
00143       DOUBLE PRECISION   ZERO
00144       PARAMETER          ( ZERO = 0.0D+0 )
00145 *     ..
00146 *     .. Local Scalars ..
00147       INTEGER            I
00148       DOUBLE PRECISION   FACT, TEMP
00149 *     ..
00150 *     .. Intrinsic Functions ..
00151       INTRINSIC          ABS
00152 *     ..
00153 *     .. External Subroutines ..
00154       EXTERNAL           XERBLA
00155 *     ..
00156 *     .. Executable Statements ..
00157 *
00158       INFO = 0
00159       IF( N.LT.0 ) THEN
00160          INFO = -1
00161          CALL XERBLA( 'DGTTRF', -INFO )
00162          RETURN
00163       END IF
00164 *
00165 *     Quick return if possible
00166 *
00167       IF( N.EQ.0 )
00168      $   RETURN
00169 *
00170 *     Initialize IPIV(i) = i and DU2(I) = 0
00171 *
00172       DO 10 I = 1, N
00173          IPIV( I ) = I
00174    10 CONTINUE
00175       DO 20 I = 1, N - 2
00176          DU2( I ) = ZERO
00177    20 CONTINUE
00178 *
00179       DO 30 I = 1, N - 2
00180          IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
00181 *
00182 *           No row interchange required, eliminate DL(I)
00183 *
00184             IF( D( I ).NE.ZERO ) THEN
00185                FACT = DL( I ) / D( I )
00186                DL( I ) = FACT
00187                D( I+1 ) = D( I+1 ) - FACT*DU( I )
00188             END IF
00189          ELSE
00190 *
00191 *           Interchange rows I and I+1, eliminate DL(I)
00192 *
00193             FACT = D( I ) / DL( I )
00194             D( I ) = DL( I )
00195             DL( I ) = FACT
00196             TEMP = DU( I )
00197             DU( I ) = D( I+1 )
00198             D( I+1 ) = TEMP - FACT*D( I+1 )
00199             DU2( I ) = DU( I+1 )
00200             DU( I+1 ) = -FACT*DU( I+1 )
00201             IPIV( I ) = I + 1
00202          END IF
00203    30 CONTINUE
00204       IF( N.GT.1 ) THEN
00205          I = N - 1
00206          IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
00207             IF( D( I ).NE.ZERO ) THEN
00208                FACT = DL( I ) / D( I )
00209                DL( I ) = FACT
00210                D( I+1 ) = D( I+1 ) - FACT*DU( I )
00211             END IF
00212          ELSE
00213             FACT = D( I ) / DL( I )
00214             D( I ) = DL( I )
00215             DL( I ) = FACT
00216             TEMP = DU( I )
00217             DU( I ) = D( I+1 )
00218             D( I+1 ) = TEMP - FACT*D( I+1 )
00219             IPIV( I ) = I + 1
00220          END IF
00221       END IF
00222 *
00223 *     Check for a zero on the diagonal of U.
00224 *
00225       DO 40 I = 1, N
00226          IF( D( I ).EQ.ZERO ) THEN
00227             INFO = I
00228             GO TO 50
00229          END IF
00230    40 CONTINUE
00231    50 CONTINUE
00232 *
00233       RETURN
00234 *
00235 *     End of DGTTRF
00236 *
00237       END
 All Files Functions