Annotation of rpl/lapack/lapack/ztftri.f, revision 1.16
1.7 bertrand 1: *> \brief \b ZTFTRI
2: *
3: * =========== DOCUMENTATION ===========
1.1 bertrand 4: *
1.13 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.1 bertrand 7: *
1.7 bertrand 8: *> \htmlonly
1.13 bertrand 9: *> Download ZTFTRI + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztftri.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztftri.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztftri.f">
1.7 bertrand 15: *> [TXT]</a>
1.13 bertrand 16: *> \endhtmlonly
1.7 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO )
1.13 bertrand 22: *
1.7 bertrand 23: * .. Scalar Arguments ..
24: * CHARACTER TRANSR, UPLO, DIAG
25: * INTEGER INFO, N
26: * ..
27: * .. Array Arguments ..
28: * COMPLEX*16 A( 0: * )
29: * ..
1.13 bertrand 30: *
1.7 bertrand 31: *
32: *> \par Purpose:
33: * =============
34: *>
35: *> \verbatim
36: *>
37: *> ZTFTRI computes the inverse of a triangular matrix A stored in RFP
38: *> format.
39: *>
40: *> This is a Level 3 BLAS version of the algorithm.
41: *> \endverbatim
42: *
43: * Arguments:
44: * ==========
45: *
46: *> \param[in] TRANSR
47: *> \verbatim
48: *> TRANSR is CHARACTER*1
49: *> = 'N': The Normal TRANSR of RFP A is stored;
50: *> = 'C': The Conjugate-transpose TRANSR of RFP A is stored.
51: *> \endverbatim
52: *>
53: *> \param[in] UPLO
54: *> \verbatim
55: *> UPLO is CHARACTER*1
56: *> = 'U': A is upper triangular;
57: *> = 'L': A is lower triangular.
58: *> \endverbatim
59: *>
60: *> \param[in] DIAG
61: *> \verbatim
62: *> DIAG is CHARACTER*1
63: *> = 'N': A is non-unit triangular;
64: *> = 'U': A is unit triangular.
65: *> \endverbatim
66: *>
67: *> \param[in] N
68: *> \verbatim
69: *> N is INTEGER
70: *> The order of the matrix A. N >= 0.
71: *> \endverbatim
72: *>
73: *> \param[in,out] A
74: *> \verbatim
75: *> A is COMPLEX*16 array, dimension ( N*(N+1)/2 );
76: *> On entry, the triangular matrix A in RFP format. RFP format
77: *> is described by TRANSR, UPLO, and N as follows: If TRANSR =
78: *> 'N' then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is
79: *> (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'C' then RFP is
80: *> the Conjugate-transpose of RFP A as defined when
81: *> TRANSR = 'N'. The contents of RFP A are defined by UPLO as
82: *> follows: If UPLO = 'U' the RFP A contains the nt elements of
83: *> upper packed A; If UPLO = 'L' the RFP A contains the nt
84: *> elements of lower packed A. The LDA of RFP A is (N+1)/2 when
85: *> TRANSR = 'C'. When TRANSR is 'N' the LDA is N+1 when N is
86: *> even and N is odd. See the Note below for more details.
87: *>
88: *> On exit, the (triangular) inverse of the original matrix, in
89: *> the same storage format.
90: *> \endverbatim
91: *>
92: *> \param[out] INFO
93: *> \verbatim
94: *> INFO is INTEGER
95: *> = 0: successful exit
96: *> < 0: if INFO = -i, the i-th argument had an illegal value
97: *> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
98: *> matrix is singular and its inverse can not be computed.
99: *> \endverbatim
100: *
101: * Authors:
102: * ========
103: *
1.13 bertrand 104: *> \author Univ. of Tennessee
105: *> \author Univ. of California Berkeley
106: *> \author Univ. of Colorado Denver
107: *> \author NAG Ltd.
1.7 bertrand 108: *
109: *> \ingroup complex16OTHERcomputational
110: *
111: *> \par Further Details:
112: * =====================
113: *>
114: *> \verbatim
115: *>
116: *> We first consider Standard Packed Format when N is even.
117: *> We give an example where N = 6.
118: *>
119: *> AP is Upper AP is Lower
120: *>
121: *> 00 01 02 03 04 05 00
122: *> 11 12 13 14 15 10 11
123: *> 22 23 24 25 20 21 22
124: *> 33 34 35 30 31 32 33
125: *> 44 45 40 41 42 43 44
126: *> 55 50 51 52 53 54 55
127: *>
128: *>
129: *> Let TRANSR = 'N'. RFP holds AP as follows:
130: *> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
131: *> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
132: *> conjugate-transpose of the first three columns of AP upper.
133: *> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
134: *> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
135: *> conjugate-transpose of the last three columns of AP lower.
136: *> To denote conjugate we place -- above the element. This covers the
137: *> case N even and TRANSR = 'N'.
138: *>
139: *> RFP A RFP A
140: *>
141: *> -- -- --
142: *> 03 04 05 33 43 53
143: *> -- --
144: *> 13 14 15 00 44 54
145: *> --
146: *> 23 24 25 10 11 55
147: *>
148: *> 33 34 35 20 21 22
149: *> --
150: *> 00 44 45 30 31 32
151: *> -- --
152: *> 01 11 55 40 41 42
153: *> -- -- --
154: *> 02 12 22 50 51 52
155: *>
156: *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
157: *> transpose of RFP A above. One therefore gets:
158: *>
159: *>
160: *> RFP A RFP A
161: *>
162: *> -- -- -- -- -- -- -- -- -- --
163: *> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
164: *> -- -- -- -- -- -- -- -- -- --
165: *> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
166: *> -- -- -- -- -- -- -- -- -- --
167: *> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
168: *>
169: *>
170: *> We next consider Standard Packed Format when N is odd.
171: *> We give an example where N = 5.
172: *>
173: *> AP is Upper AP is Lower
174: *>
175: *> 00 01 02 03 04 00
176: *> 11 12 13 14 10 11
177: *> 22 23 24 20 21 22
178: *> 33 34 30 31 32 33
179: *> 44 40 41 42 43 44
180: *>
181: *>
182: *> Let TRANSR = 'N'. RFP holds AP as follows:
183: *> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
184: *> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
185: *> conjugate-transpose of the first two columns of AP upper.
186: *> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
187: *> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
188: *> conjugate-transpose of the last two columns of AP lower.
189: *> To denote conjugate we place -- above the element. This covers the
190: *> case N odd and TRANSR = 'N'.
191: *>
192: *> RFP A RFP A
193: *>
194: *> -- --
195: *> 02 03 04 00 33 43
196: *> --
197: *> 12 13 14 10 11 44
198: *>
199: *> 22 23 24 20 21 22
200: *> --
201: *> 00 33 34 30 31 32
202: *> -- --
203: *> 01 11 44 40 41 42
204: *>
205: *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
206: *> transpose of RFP A above. One therefore gets:
207: *>
208: *>
209: *> RFP A RFP A
210: *>
211: *> -- -- -- -- -- -- -- -- --
212: *> 02 12 22 00 01 00 10 20 30 40 50
213: *> -- -- -- -- -- -- -- -- --
214: *> 03 13 23 33 11 33 11 21 31 41 51
215: *> -- -- -- -- -- -- -- -- --
216: *> 04 14 24 34 44 43 44 22 32 42 52
217: *> \endverbatim
218: *>
219: * =====================================================================
220: SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO )
1.1 bertrand 221: *
1.16 ! bertrand 222: * -- LAPACK computational routine --
1.1 bertrand 223: * -- LAPACK is a software package provided by Univ. of Tennessee, --
224: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
225: *
226: * .. Scalar Arguments ..
227: CHARACTER TRANSR, UPLO, DIAG
228: INTEGER INFO, N
229: * ..
230: * .. Array Arguments ..
231: COMPLEX*16 A( 0: * )
232: * ..
233: *
234: * =====================================================================
235: *
236: * .. Parameters ..
237: COMPLEX*16 CONE
238: PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) )
239: * ..
240: * .. Local Scalars ..
241: LOGICAL LOWER, NISODD, NORMALTRANSR
242: INTEGER N1, N2, K
243: * ..
244: * .. External Functions ..
245: LOGICAL LSAME
246: EXTERNAL LSAME
247: * ..
248: * .. External Subroutines ..
249: EXTERNAL XERBLA, ZTRMM, ZTRTRI
250: * ..
251: * .. Intrinsic Functions ..
252: INTRINSIC MOD
253: * ..
254: * .. Executable Statements ..
255: *
256: * Test the input parameters.
257: *
258: INFO = 0
259: NORMALTRANSR = LSAME( TRANSR, 'N' )
260: LOWER = LSAME( UPLO, 'L' )
261: IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN
262: INFO = -1
263: ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
264: INFO = -2
265: ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) )
1.6 bertrand 266: $ THEN
1.1 bertrand 267: INFO = -3
268: ELSE IF( N.LT.0 ) THEN
269: INFO = -4
270: END IF
271: IF( INFO.NE.0 ) THEN
272: CALL XERBLA( 'ZTFTRI', -INFO )
273: RETURN
274: END IF
275: *
276: * Quick return if possible
277: *
278: IF( N.EQ.0 )
1.6 bertrand 279: $ RETURN
1.1 bertrand 280: *
281: * If N is odd, set NISODD = .TRUE.
282: * If N is even, set K = N/2 and NISODD = .FALSE.
283: *
284: IF( MOD( N, 2 ).EQ.0 ) THEN
285: K = N / 2
286: NISODD = .FALSE.
287: ELSE
288: NISODD = .TRUE.
289: END IF
290: *
291: * Set N1 and N2 depending on LOWER
292: *
293: IF( LOWER ) THEN
294: N2 = N / 2
295: N1 = N - N2
296: ELSE
297: N1 = N / 2
298: N2 = N - N1
299: END IF
300: *
301: *
302: * start execution: there are eight cases
303: *
304: IF( NISODD ) THEN
305: *
306: * N is odd
307: *
308: IF( NORMALTRANSR ) THEN
309: *
310: * N is odd and TRANSR = 'N'
311: *
312: IF( LOWER ) THEN
313: *
314: * SRPA for LOWER, NORMAL and N is odd ( a(0:n-1,0:n1-1) )
315: * T1 -> a(0,0), T2 -> a(0,1), S -> a(n1,0)
316: * T1 -> a(0), T2 -> a(n), S -> a(n1)
317: *
318: CALL ZTRTRI( 'L', DIAG, N1, A( 0 ), N, INFO )
319: IF( INFO.GT.0 )
1.6 bertrand 320: $ RETURN
1.1 bertrand 321: CALL ZTRMM( 'R', 'L', 'N', DIAG, N2, N1, -CONE, A( 0 ),
1.6 bertrand 322: $ N, A( N1 ), N )
1.1 bertrand 323: CALL ZTRTRI( 'U', DIAG, N2, A( N ), N, INFO )
324: IF( INFO.GT.0 )
1.6 bertrand 325: $ INFO = INFO + N1
1.1 bertrand 326: IF( INFO.GT.0 )
1.6 bertrand 327: $ RETURN
1.1 bertrand 328: CALL ZTRMM( 'L', 'U', 'C', DIAG, N2, N1, CONE, A( N ), N,
1.6 bertrand 329: $ A( N1 ), N )
1.1 bertrand 330: *
331: ELSE
332: *
333: * SRPA for UPPER, NORMAL and N is odd ( a(0:n-1,0:n2-1)
334: * T1 -> a(n1+1,0), T2 -> a(n1,0), S -> a(0,0)
335: * T1 -> a(n2), T2 -> a(n1), S -> a(0)
336: *
337: CALL ZTRTRI( 'L', DIAG, N1, A( N2 ), N, INFO )
338: IF( INFO.GT.0 )
1.6 bertrand 339: $ RETURN
1.1 bertrand 340: CALL ZTRMM( 'L', 'L', 'C', DIAG, N1, N2, -CONE, A( N2 ),
1.6 bertrand 341: $ N, A( 0 ), N )
1.1 bertrand 342: CALL ZTRTRI( 'U', DIAG, N2, A( N1 ), N, INFO )
343: IF( INFO.GT.0 )
1.6 bertrand 344: $ INFO = INFO + N1
1.1 bertrand 345: IF( INFO.GT.0 )
1.6 bertrand 346: $ RETURN
1.1 bertrand 347: CALL ZTRMM( 'R', 'U', 'N', DIAG, N1, N2, CONE, A( N1 ),
1.6 bertrand 348: $ N, A( 0 ), N )
1.1 bertrand 349: *
350: END IF
351: *
352: ELSE
353: *
354: * N is odd and TRANSR = 'C'
355: *
356: IF( LOWER ) THEN
357: *
358: * SRPA for LOWER, TRANSPOSE and N is odd
359: * T1 -> a(0), T2 -> a(1), S -> a(0+n1*n1)
360: *
361: CALL ZTRTRI( 'U', DIAG, N1, A( 0 ), N1, INFO )
362: IF( INFO.GT.0 )
1.6 bertrand 363: $ RETURN
1.1 bertrand 364: CALL ZTRMM( 'L', 'U', 'N', DIAG, N1, N2, -CONE, A( 0 ),
1.6 bertrand 365: $ N1, A( N1*N1 ), N1 )
1.1 bertrand 366: CALL ZTRTRI( 'L', DIAG, N2, A( 1 ), N1, INFO )
367: IF( INFO.GT.0 )
1.6 bertrand 368: $ INFO = INFO + N1
1.1 bertrand 369: IF( INFO.GT.0 )
1.6 bertrand 370: $ RETURN
1.1 bertrand 371: CALL ZTRMM( 'R', 'L', 'C', DIAG, N1, N2, CONE, A( 1 ),
1.6 bertrand 372: $ N1, A( N1*N1 ), N1 )
1.1 bertrand 373: *
374: ELSE
375: *
376: * SRPA for UPPER, TRANSPOSE and N is odd
377: * T1 -> a(0+n2*n2), T2 -> a(0+n1*n2), S -> a(0)
378: *
379: CALL ZTRTRI( 'U', DIAG, N1, A( N2*N2 ), N2, INFO )
380: IF( INFO.GT.0 )
1.6 bertrand 381: $ RETURN
1.1 bertrand 382: CALL ZTRMM( 'R', 'U', 'C', DIAG, N2, N1, -CONE,
1.6 bertrand 383: $ A( N2*N2 ), N2, A( 0 ), N2 )
1.1 bertrand 384: CALL ZTRTRI( 'L', DIAG, N2, A( N1*N2 ), N2, INFO )
385: IF( INFO.GT.0 )
1.6 bertrand 386: $ INFO = INFO + N1
1.1 bertrand 387: IF( INFO.GT.0 )
1.6 bertrand 388: $ RETURN
1.1 bertrand 389: CALL ZTRMM( 'L', 'L', 'N', DIAG, N2, N1, CONE,
1.6 bertrand 390: $ A( N1*N2 ), N2, A( 0 ), N2 )
1.1 bertrand 391: END IF
392: *
393: END IF
394: *
395: ELSE
396: *
397: * N is even
398: *
399: IF( NORMALTRANSR ) THEN
400: *
401: * N is even and TRANSR = 'N'
402: *
403: IF( LOWER ) THEN
404: *
405: * SRPA for LOWER, NORMAL, and N is even ( a(0:n,0:k-1) )
406: * T1 -> a(1,0), T2 -> a(0,0), S -> a(k+1,0)
407: * T1 -> a(1), T2 -> a(0), S -> a(k+1)
408: *
409: CALL ZTRTRI( 'L', DIAG, K, A( 1 ), N+1, INFO )
410: IF( INFO.GT.0 )
1.6 bertrand 411: $ RETURN
1.1 bertrand 412: CALL ZTRMM( 'R', 'L', 'N', DIAG, K, K, -CONE, A( 1 ),
1.6 bertrand 413: $ N+1, A( K+1 ), N+1 )
1.1 bertrand 414: CALL ZTRTRI( 'U', DIAG, K, A( 0 ), N+1, INFO )
415: IF( INFO.GT.0 )
1.6 bertrand 416: $ INFO = INFO + K
1.1 bertrand 417: IF( INFO.GT.0 )
1.6 bertrand 418: $ RETURN
1.1 bertrand 419: CALL ZTRMM( 'L', 'U', 'C', DIAG, K, K, CONE, A( 0 ), N+1,
1.6 bertrand 420: $ A( K+1 ), N+1 )
1.1 bertrand 421: *
422: ELSE
423: *
424: * SRPA for UPPER, NORMAL, and N is even ( a(0:n,0:k-1) )
425: * T1 -> a(k+1,0) , T2 -> a(k,0), S -> a(0,0)
426: * T1 -> a(k+1), T2 -> a(k), S -> a(0)
427: *
428: CALL ZTRTRI( 'L', DIAG, K, A( K+1 ), N+1, INFO )
429: IF( INFO.GT.0 )
1.6 bertrand 430: $ RETURN
1.1 bertrand 431: CALL ZTRMM( 'L', 'L', 'C', DIAG, K, K, -CONE, A( K+1 ),
1.6 bertrand 432: $ N+1, A( 0 ), N+1 )
1.1 bertrand 433: CALL ZTRTRI( 'U', DIAG, K, A( K ), N+1, INFO )
434: IF( INFO.GT.0 )
1.6 bertrand 435: $ INFO = INFO + K
1.1 bertrand 436: IF( INFO.GT.0 )
1.6 bertrand 437: $ RETURN
1.1 bertrand 438: CALL ZTRMM( 'R', 'U', 'N', DIAG, K, K, CONE, A( K ), N+1,
1.6 bertrand 439: $ A( 0 ), N+1 )
1.1 bertrand 440: END IF
441: ELSE
442: *
443: * N is even and TRANSR = 'C'
444: *
445: IF( LOWER ) THEN
446: *
447: * SRPA for LOWER, TRANSPOSE and N is even (see paper)
448: * T1 -> B(0,1), T2 -> B(0,0), S -> B(0,k+1)
449: * T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k
450: *
451: CALL ZTRTRI( 'U', DIAG, K, A( K ), K, INFO )
452: IF( INFO.GT.0 )
1.6 bertrand 453: $ RETURN
1.1 bertrand 454: CALL ZTRMM( 'L', 'U', 'N', DIAG, K, K, -CONE, A( K ), K,
1.6 bertrand 455: $ A( K*( K+1 ) ), K )
1.1 bertrand 456: CALL ZTRTRI( 'L', DIAG, K, A( 0 ), K, INFO )
457: IF( INFO.GT.0 )
1.6 bertrand 458: $ INFO = INFO + K
1.1 bertrand 459: IF( INFO.GT.0 )
1.6 bertrand 460: $ RETURN
1.1 bertrand 461: CALL ZTRMM( 'R', 'L', 'C', DIAG, K, K, CONE, A( 0 ), K,
1.6 bertrand 462: $ A( K*( K+1 ) ), K )
1.1 bertrand 463: ELSE
464: *
465: * SRPA for UPPER, TRANSPOSE and N is even (see paper)
466: * T1 -> B(0,k+1), T2 -> B(0,k), S -> B(0,0)
467: * T1 -> a(0+k*(k+1)), T2 -> a(0+k*k), S -> a(0+0)); lda=k
468: *
469: CALL ZTRTRI( 'U', DIAG, K, A( K*( K+1 ) ), K, INFO )
470: IF( INFO.GT.0 )
1.6 bertrand 471: $ RETURN
1.1 bertrand 472: CALL ZTRMM( 'R', 'U', 'C', DIAG, K, K, -CONE,
1.6 bertrand 473: $ A( K*( K+1 ) ), K, A( 0 ), K )
1.1 bertrand 474: CALL ZTRTRI( 'L', DIAG, K, A( K*K ), K, INFO )
475: IF( INFO.GT.0 )
1.6 bertrand 476: $ INFO = INFO + K
1.1 bertrand 477: IF( INFO.GT.0 )
1.6 bertrand 478: $ RETURN
1.1 bertrand 479: CALL ZTRMM( 'L', 'L', 'N', DIAG, K, K, CONE, A( K*K ), K,
1.6 bertrand 480: $ A( 0 ), K )
1.1 bertrand 481: END IF
482: END IF
483: END IF
484: *
485: RETURN
486: *
487: * End of ZTFTRI
488: *
489: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ztftri.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack