LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zgttrf.f
Go to the documentation of this file.
00001 *> \brief \b ZGTTRF
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZGTTRF + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgttrf.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgttrf.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgttrf.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            INFO, N
00025 *       ..
00026 *       .. Array Arguments ..
00027 *       INTEGER            IPIV( * )
00028 *       COMPLEX*16         D( * ), DL( * ), DU( * ), DU2( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> ZGTTRF computes an LU factorization of a complex 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 COMPLEX*16 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 COMPLEX*16 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 COMPLEX*16 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 COMPLEX*16 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 complex16OTHERcomputational
00123 *
00124 *  =====================================================================
00125       SUBROUTINE ZGTTRF( 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       COMPLEX*16         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       COMPLEX*16         FACT, TEMP, ZDUM
00149 *     ..
00150 *     .. External Subroutines ..
00151       EXTERNAL           XERBLA
00152 *     ..
00153 *     .. Intrinsic Functions ..
00154       INTRINSIC          ABS, DBLE, DIMAG
00155 *     ..
00156 *     .. Statement Functions ..
00157       DOUBLE PRECISION   CABS1
00158 *     ..
00159 *     .. Statement Function definitions ..
00160       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
00161 *     ..
00162 *     .. Executable Statements ..
00163 *
00164       INFO = 0
00165       IF( N.LT.0 ) THEN
00166          INFO = -1
00167          CALL XERBLA( 'ZGTTRF', -INFO )
00168          RETURN
00169       END IF
00170 *
00171 *     Quick return if possible
00172 *
00173       IF( N.EQ.0 )
00174      $   RETURN
00175 *
00176 *     Initialize IPIV(i) = i and DU2(i) = 0
00177 *
00178       DO 10 I = 1, N
00179          IPIV( I ) = I
00180    10 CONTINUE
00181       DO 20 I = 1, N - 2
00182          DU2( I ) = ZERO
00183    20 CONTINUE
00184 *
00185       DO 30 I = 1, N - 2
00186          IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
00187 *
00188 *           No row interchange required, eliminate DL(I)
00189 *
00190             IF( CABS1( D( I ) ).NE.ZERO ) THEN
00191                FACT = DL( I ) / D( I )
00192                DL( I ) = FACT
00193                D( I+1 ) = D( I+1 ) - FACT*DU( I )
00194             END IF
00195          ELSE
00196 *
00197 *           Interchange rows I and I+1, eliminate DL(I)
00198 *
00199             FACT = D( I ) / DL( I )
00200             D( I ) = DL( I )
00201             DL( I ) = FACT
00202             TEMP = DU( I )
00203             DU( I ) = D( I+1 )
00204             D( I+1 ) = TEMP - FACT*D( I+1 )
00205             DU2( I ) = DU( I+1 )
00206             DU( I+1 ) = -FACT*DU( I+1 )
00207             IPIV( I ) = I + 1
00208          END IF
00209    30 CONTINUE
00210       IF( N.GT.1 ) THEN
00211          I = N - 1
00212          IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
00213             IF( CABS1( D( I ) ).NE.ZERO ) THEN
00214                FACT = DL( I ) / D( I )
00215                DL( I ) = FACT
00216                D( I+1 ) = D( I+1 ) - FACT*DU( I )
00217             END IF
00218          ELSE
00219             FACT = D( I ) / DL( I )
00220             D( I ) = DL( I )
00221             DL( I ) = FACT
00222             TEMP = DU( I )
00223             DU( I ) = D( I+1 )
00224             D( I+1 ) = TEMP - FACT*D( I+1 )
00225             IPIV( I ) = I + 1
00226          END IF
00227       END IF
00228 *
00229 *     Check for a zero on the diagonal of U.
00230 *
00231       DO 40 I = 1, N
00232          IF( CABS1( D( I ) ).EQ.ZERO ) THEN
00233             INFO = I
00234             GO TO 50
00235          END IF
00236    40 CONTINUE
00237    50 CONTINUE
00238 *
00239       RETURN
00240 *
00241 *     End of ZGTTRF
00242 *
00243       END
 All Files Functions