Annotation of rpl/lapack/lapack/dgtsv.f, revision 1.9
1.9 ! bertrand 1: *> \brief \b DGTSV
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download DGTSV + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgtsv.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgtsv.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgtsv.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
! 22: *
! 23: * .. Scalar Arguments ..
! 24: * INTEGER INFO, LDB, N, NRHS
! 25: * ..
! 26: * .. Array Arguments ..
! 27: * DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * )
! 28: * ..
! 29: *
! 30: *
! 31: *> \par Purpose:
! 32: * =============
! 33: *>
! 34: *> \verbatim
! 35: *>
! 36: *> DGTSV solves the equation
! 37: *>
! 38: *> A*X = B,
! 39: *>
! 40: *> where A is an n by n tridiagonal matrix, by Gaussian elimination with
! 41: *> partial pivoting.
! 42: *>
! 43: *> Note that the equation A**T*X = B may be solved by interchanging the
! 44: *> order of the arguments DU and DL.
! 45: *> \endverbatim
! 46: *
! 47: * Arguments:
! 48: * ==========
! 49: *
! 50: *> \param[in] N
! 51: *> \verbatim
! 52: *> N is INTEGER
! 53: *> The order of the matrix A. N >= 0.
! 54: *> \endverbatim
! 55: *>
! 56: *> \param[in] NRHS
! 57: *> \verbatim
! 58: *> NRHS is INTEGER
! 59: *> The number of right hand sides, i.e., the number of columns
! 60: *> of the matrix B. NRHS >= 0.
! 61: *> \endverbatim
! 62: *>
! 63: *> \param[in,out] DL
! 64: *> \verbatim
! 65: *> DL is DOUBLE PRECISION array, dimension (N-1)
! 66: *> On entry, DL must contain the (n-1) sub-diagonal elements of
! 67: *> A.
! 68: *>
! 69: *> On exit, DL is overwritten by the (n-2) elements of the
! 70: *> second super-diagonal of the upper triangular matrix U from
! 71: *> the LU factorization of A, in DL(1), ..., DL(n-2).
! 72: *> \endverbatim
! 73: *>
! 74: *> \param[in,out] D
! 75: *> \verbatim
! 76: *> D is DOUBLE PRECISION array, dimension (N)
! 77: *> On entry, D must contain the diagonal elements of A.
! 78: *>
! 79: *> On exit, D is overwritten by the n diagonal elements of U.
! 80: *> \endverbatim
! 81: *>
! 82: *> \param[in,out] DU
! 83: *> \verbatim
! 84: *> DU is DOUBLE PRECISION array, dimension (N-1)
! 85: *> On entry, DU must contain the (n-1) super-diagonal elements
! 86: *> of A.
! 87: *>
! 88: *> On exit, DU is overwritten by the (n-1) elements of the first
! 89: *> super-diagonal of U.
! 90: *> \endverbatim
! 91: *>
! 92: *> \param[in,out] B
! 93: *> \verbatim
! 94: *> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
! 95: *> On entry, the N by NRHS matrix of right hand side matrix B.
! 96: *> On exit, if INFO = 0, the N by NRHS solution matrix X.
! 97: *> \endverbatim
! 98: *>
! 99: *> \param[in] LDB
! 100: *> \verbatim
! 101: *> LDB is INTEGER
! 102: *> The leading dimension of the array B. LDB >= max(1,N).
! 103: *> \endverbatim
! 104: *>
! 105: *> \param[out] INFO
! 106: *> \verbatim
! 107: *> INFO is INTEGER
! 108: *> = 0: successful exit
! 109: *> < 0: if INFO = -i, the i-th argument had an illegal value
! 110: *> > 0: if INFO = i, U(i,i) is exactly zero, and the solution
! 111: *> has not been computed. The factorization has not been
! 112: *> completed unless i = N.
! 113: *> \endverbatim
! 114: *
! 115: * Authors:
! 116: * ========
! 117: *
! 118: *> \author Univ. of Tennessee
! 119: *> \author Univ. of California Berkeley
! 120: *> \author Univ. of Colorado Denver
! 121: *> \author NAG Ltd.
! 122: *
! 123: *> \date November 2011
! 124: *
! 125: *> \ingroup doubleOTHERcomputational
! 126: *
! 127: * =====================================================================
1.1 bertrand 128: SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
129: *
1.9 ! bertrand 130: * -- LAPACK computational routine (version 3.4.0) --
1.1 bertrand 131: * -- LAPACK is a software package provided by Univ. of Tennessee, --
132: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9 ! bertrand 133: * November 2011
1.1 bertrand 134: *
135: * .. Scalar Arguments ..
136: INTEGER INFO, LDB, N, NRHS
137: * ..
138: * .. Array Arguments ..
139: DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * )
140: * ..
141: *
142: * =====================================================================
143: *
144: * .. Parameters ..
145: DOUBLE PRECISION ZERO
146: PARAMETER ( ZERO = 0.0D+0 )
147: * ..
148: * .. Local Scalars ..
149: INTEGER I, J
150: DOUBLE PRECISION FACT, TEMP
151: * ..
152: * .. Intrinsic Functions ..
153: INTRINSIC ABS, MAX
154: * ..
155: * .. External Subroutines ..
156: EXTERNAL XERBLA
157: * ..
158: * .. Executable Statements ..
159: *
160: INFO = 0
161: IF( N.LT.0 ) THEN
162: INFO = -1
163: ELSE IF( NRHS.LT.0 ) THEN
164: INFO = -2
165: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
166: INFO = -7
167: END IF
168: IF( INFO.NE.0 ) THEN
169: CALL XERBLA( 'DGTSV ', -INFO )
170: RETURN
171: END IF
172: *
173: IF( N.EQ.0 )
174: $ RETURN
175: *
176: IF( NRHS.EQ.1 ) THEN
177: DO 10 I = 1, N - 2
178: IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
179: *
180: * No row interchange required
181: *
182: IF( D( I ).NE.ZERO ) THEN
183: FACT = DL( I ) / D( I )
184: D( I+1 ) = D( I+1 ) - FACT*DU( I )
185: B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
186: ELSE
187: INFO = I
188: RETURN
189: END IF
190: DL( I ) = ZERO
191: ELSE
192: *
193: * Interchange rows I and I+1
194: *
195: FACT = D( I ) / DL( I )
196: D( I ) = DL( I )
197: TEMP = D( I+1 )
198: D( I+1 ) = DU( I ) - FACT*TEMP
199: DL( I ) = DU( I+1 )
200: DU( I+1 ) = -FACT*DL( I )
201: DU( I ) = TEMP
202: TEMP = B( I, 1 )
203: B( I, 1 ) = B( I+1, 1 )
204: B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
205: END IF
206: 10 CONTINUE
207: IF( N.GT.1 ) THEN
208: I = N - 1
209: IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
210: IF( D( I ).NE.ZERO ) THEN
211: FACT = DL( I ) / D( I )
212: D( I+1 ) = D( I+1 ) - FACT*DU( I )
213: B( I+1, 1 ) = B( I+1, 1 ) - FACT*B( I, 1 )
214: ELSE
215: INFO = I
216: RETURN
217: END IF
218: ELSE
219: FACT = D( I ) / DL( I )
220: D( I ) = DL( I )
221: TEMP = D( I+1 )
222: D( I+1 ) = DU( I ) - FACT*TEMP
223: DU( I ) = TEMP
224: TEMP = B( I, 1 )
225: B( I, 1 ) = B( I+1, 1 )
226: B( I+1, 1 ) = TEMP - FACT*B( I+1, 1 )
227: END IF
228: END IF
229: IF( D( N ).EQ.ZERO ) THEN
230: INFO = N
231: RETURN
232: END IF
233: ELSE
234: DO 40 I = 1, N - 2
235: IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
236: *
237: * No row interchange required
238: *
239: IF( D( I ).NE.ZERO ) THEN
240: FACT = DL( I ) / D( I )
241: D( I+1 ) = D( I+1 ) - FACT*DU( I )
242: DO 20 J = 1, NRHS
243: B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
244: 20 CONTINUE
245: ELSE
246: INFO = I
247: RETURN
248: END IF
249: DL( I ) = ZERO
250: ELSE
251: *
252: * Interchange rows I and I+1
253: *
254: FACT = D( I ) / DL( I )
255: D( I ) = DL( I )
256: TEMP = D( I+1 )
257: D( I+1 ) = DU( I ) - FACT*TEMP
258: DL( I ) = DU( I+1 )
259: DU( I+1 ) = -FACT*DL( I )
260: DU( I ) = TEMP
261: DO 30 J = 1, NRHS
262: TEMP = B( I, J )
263: B( I, J ) = B( I+1, J )
264: B( I+1, J ) = TEMP - FACT*B( I+1, J )
265: 30 CONTINUE
266: END IF
267: 40 CONTINUE
268: IF( N.GT.1 ) THEN
269: I = N - 1
270: IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
271: IF( D( I ).NE.ZERO ) THEN
272: FACT = DL( I ) / D( I )
273: D( I+1 ) = D( I+1 ) - FACT*DU( I )
274: DO 50 J = 1, NRHS
275: B( I+1, J ) = B( I+1, J ) - FACT*B( I, J )
276: 50 CONTINUE
277: ELSE
278: INFO = I
279: RETURN
280: END IF
281: ELSE
282: FACT = D( I ) / DL( I )
283: D( I ) = DL( I )
284: TEMP = D( I+1 )
285: D( I+1 ) = DU( I ) - FACT*TEMP
286: DU( I ) = TEMP
287: DO 60 J = 1, NRHS
288: TEMP = B( I, J )
289: B( I, J ) = B( I+1, J )
290: B( I+1, J ) = TEMP - FACT*B( I+1, J )
291: 60 CONTINUE
292: END IF
293: END IF
294: IF( D( N ).EQ.ZERO ) THEN
295: INFO = N
296: RETURN
297: END IF
298: END IF
299: *
300: * Back solve with the matrix U from the factorization.
301: *
302: IF( NRHS.LE.2 ) THEN
303: J = 1
304: 70 CONTINUE
305: B( N, J ) = B( N, J ) / D( N )
306: IF( N.GT.1 )
307: $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 )
308: DO 80 I = N - 2, 1, -1
309: B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
310: $ B( I+2, J ) ) / D( I )
311: 80 CONTINUE
312: IF( J.LT.NRHS ) THEN
313: J = J + 1
314: GO TO 70
315: END IF
316: ELSE
317: DO 100 J = 1, NRHS
318: B( N, J ) = B( N, J ) / D( N )
319: IF( N.GT.1 )
320: $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
321: $ D( N-1 )
322: DO 90 I = N - 2, 1, -1
323: B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DL( I )*
324: $ B( I+2, J ) ) / D( I )
325: 90 CONTINUE
326: 100 CONTINUE
327: END IF
328: *
329: RETURN
330: *
331: * End of DGTSV
332: *
333: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dgtsv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack