LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cpftrs.f
Go to the documentation of this file.
1 *> \brief \b CPFTRS
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download CPFTRS + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpftrs.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpftrs.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpftrs.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER TRANSR, UPLO
25 * INTEGER INFO, LDB, N, NRHS
26 * ..
27 * .. Array Arguments ..
28 * COMPLEX A( 0: * ), B( LDB, * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> CPFTRS solves a system of linear equations A*X = B with a Hermitian
38 *> positive definite matrix A using the Cholesky factorization
39 *> A = U**H*U or A = L*L**H computed by CPFTRF.
40 *> \endverbatim
41 *
42 * Arguments:
43 * ==========
44 *
45 *> \param[in] TRANSR
46 *> \verbatim
47 *> TRANSR is CHARACTER*1
48 *> = 'N': The Normal TRANSR of RFP A is stored;
49 *> = 'C': The Conjugate-transpose TRANSR of RFP A is stored.
50 *> \endverbatim
51 *>
52 *> \param[in] UPLO
53 *> \verbatim
54 *> UPLO is CHARACTER*1
55 *> = 'U': Upper triangle of RFP A is stored;
56 *> = 'L': Lower triangle of RFP A is stored.
57 *> \endverbatim
58 *>
59 *> \param[in] N
60 *> \verbatim
61 *> N is INTEGER
62 *> The order of the matrix A. N >= 0.
63 *> \endverbatim
64 *>
65 *> \param[in] NRHS
66 *> \verbatim
67 *> NRHS is INTEGER
68 *> The number of right hand sides, i.e., the number of columns
69 *> of the matrix B. NRHS >= 0.
70 *> \endverbatim
71 *>
72 *> \param[in] A
73 *> \verbatim
74 *> A is COMPLEX array, dimension ( N*(N+1)/2 );
75 *> The triangular factor U or L from the Cholesky factorization
76 *> of RFP A = U**H*U or RFP A = L*L**H, as computed by CPFTRF.
77 *> See note below for more details about RFP A.
78 *> \endverbatim
79 *>
80 *> \param[in,out] B
81 *> \verbatim
82 *> B is COMPLEX array, dimension (LDB,NRHS)
83 *> On entry, the right hand side matrix B.
84 *> On exit, the solution matrix X.
85 *> \endverbatim
86 *>
87 *> \param[in] LDB
88 *> \verbatim
89 *> LDB is INTEGER
90 *> The leading dimension of the array B. LDB >= max(1,N).
91 *> \endverbatim
92 *>
93 *> \param[out] INFO
94 *> \verbatim
95 *> INFO is INTEGER
96 *> = 0: successful exit
97 *> < 0: if INFO = -i, the i-th argument had an illegal value
98 *> \endverbatim
99 *
100 * Authors:
101 * ========
102 *
103 *> \author Univ. of Tennessee
104 *> \author Univ. of California Berkeley
105 *> \author Univ. of Colorado Denver
106 *> \author NAG Ltd.
107 *
108 *> \date November 2011
109 *
110 *> \ingroup complexOTHERcomputational
111 *
112 *> \par Further Details:
113 * =====================
114 *>
115 *> \verbatim
116 *>
117 *> We first consider Standard Packed Format when N is even.
118 *> We give an example where N = 6.
119 *>
120 *> AP is Upper AP is Lower
121 *>
122 *> 00 01 02 03 04 05 00
123 *> 11 12 13 14 15 10 11
124 *> 22 23 24 25 20 21 22
125 *> 33 34 35 30 31 32 33
126 *> 44 45 40 41 42 43 44
127 *> 55 50 51 52 53 54 55
128 *>
129 *>
130 *> Let TRANSR = 'N'. RFP holds AP as follows:
131 *> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
132 *> three columns of AP upper. The lower triangle A(4:6,0:2) consists of
133 *> conjugate-transpose of the first three columns of AP upper.
134 *> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
135 *> three columns of AP lower. The upper triangle A(0:2,0:2) consists of
136 *> conjugate-transpose of the last three columns of AP lower.
137 *> To denote conjugate we place -- above the element. This covers the
138 *> case N even and TRANSR = 'N'.
139 *>
140 *> RFP A RFP A
141 *>
142 *> -- -- --
143 *> 03 04 05 33 43 53
144 *> -- --
145 *> 13 14 15 00 44 54
146 *> --
147 *> 23 24 25 10 11 55
148 *>
149 *> 33 34 35 20 21 22
150 *> --
151 *> 00 44 45 30 31 32
152 *> -- --
153 *> 01 11 55 40 41 42
154 *> -- -- --
155 *> 02 12 22 50 51 52
156 *>
157 *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
158 *> transpose of RFP A above. One therefore gets:
159 *>
160 *>
161 *> RFP A RFP A
162 *>
163 *> -- -- -- -- -- -- -- -- -- --
164 *> 03 13 23 33 00 01 02 33 00 10 20 30 40 50
165 *> -- -- -- -- -- -- -- -- -- --
166 *> 04 14 24 34 44 11 12 43 44 11 21 31 41 51
167 *> -- -- -- -- -- -- -- -- -- --
168 *> 05 15 25 35 45 55 22 53 54 55 22 32 42 52
169 *>
170 *>
171 *> We next consider Standard Packed Format when N is odd.
172 *> We give an example where N = 5.
173 *>
174 *> AP is Upper AP is Lower
175 *>
176 *> 00 01 02 03 04 00
177 *> 11 12 13 14 10 11
178 *> 22 23 24 20 21 22
179 *> 33 34 30 31 32 33
180 *> 44 40 41 42 43 44
181 *>
182 *>
183 *> Let TRANSR = 'N'. RFP holds AP as follows:
184 *> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
185 *> three columns of AP upper. The lower triangle A(3:4,0:1) consists of
186 *> conjugate-transpose of the first two columns of AP upper.
187 *> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
188 *> three columns of AP lower. The upper triangle A(0:1,1:2) consists of
189 *> conjugate-transpose of the last two columns of AP lower.
190 *> To denote conjugate we place -- above the element. This covers the
191 *> case N odd and TRANSR = 'N'.
192 *>
193 *> RFP A RFP A
194 *>
195 *> -- --
196 *> 02 03 04 00 33 43
197 *> --
198 *> 12 13 14 10 11 44
199 *>
200 *> 22 23 24 20 21 22
201 *> --
202 *> 00 33 34 30 31 32
203 *> -- --
204 *> 01 11 44 40 41 42
205 *>
206 *> Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
207 *> transpose of RFP A above. One therefore gets:
208 *>
209 *>
210 *> RFP A RFP A
211 *>
212 *> -- -- -- -- -- -- -- -- --
213 *> 02 12 22 00 01 00 10 20 30 40 50
214 *> -- -- -- -- -- -- -- -- --
215 *> 03 13 23 33 11 33 11 21 31 41 51
216 *> -- -- -- -- -- -- -- -- --
217 *> 04 14 24 34 44 43 44 22 32 42 52
218 *> \endverbatim
219 *>
220 * =====================================================================
221  SUBROUTINE cpftrs( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
222 *
223 * -- LAPACK computational routine (version 3.4.0) --
224 * -- LAPACK is a software package provided by Univ. of Tennessee, --
225 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
226 * November 2011
227 *
228 * .. Scalar Arguments ..
229  CHARACTER transr, uplo
230  INTEGER info, ldb, n, nrhs
231 * ..
232 * .. Array Arguments ..
233  COMPLEX a( 0: * ), b( ldb, * )
234 * ..
235 *
236 * =====================================================================
237 *
238 * .. Parameters ..
239  COMPLEX cone
240  parameter( cone = ( 1.0e+0, 0.0e+0 ) )
241 * ..
242 * .. Local Scalars ..
243  LOGICAL lower, normaltransr
244 * ..
245 * .. External Functions ..
246  LOGICAL lsame
247  EXTERNAL lsame
248 * ..
249 * .. External Subroutines ..
250  EXTERNAL xerbla, ctfsm
251 * ..
252 * .. Intrinsic Functions ..
253  INTRINSIC max
254 * ..
255 * .. Executable Statements ..
256 *
257 * Test the input parameters.
258 *
259  info = 0
260  normaltransr = lsame( transr, 'N' )
261  lower = lsame( uplo, 'L' )
262  IF( .NOT.normaltransr .AND. .NOT.lsame( transr, 'C' ) ) THEN
263  info = -1
264  ELSE IF( .NOT.lower .AND. .NOT.lsame( uplo, 'U' ) ) THEN
265  info = -2
266  ELSE IF( n.LT.0 ) THEN
267  info = -3
268  ELSE IF( nrhs.LT.0 ) THEN
269  info = -4
270  ELSE IF( ldb.LT.max( 1, n ) ) THEN
271  info = -7
272  END IF
273  IF( info.NE.0 ) THEN
274  CALL xerbla( 'CPFTRS', -info )
275  return
276  END IF
277 *
278 * Quick return if possible
279 *
280  IF( n.EQ.0 .OR. nrhs.EQ.0 )
281  $ return
282 *
283 * start execution: there are two triangular solves
284 *
285  IF( lower ) THEN
286  CALL ctfsm( transr, 'L', uplo, 'N', 'N', n, nrhs, cone, a, b,
287  $ ldb )
288  CALL ctfsm( transr, 'L', uplo, 'C', 'N', n, nrhs, cone, a, b,
289  $ ldb )
290  ELSE
291  CALL ctfsm( transr, 'L', uplo, 'C', 'N', n, nrhs, cone, a, b,
292  $ ldb )
293  CALL ctfsm( transr, 'L', uplo, 'N', 'N', n, nrhs, cone, a, b,
294  $ ldb )
295  END IF
296 *
297  return
298 *
299 * End of CPFTRS
300 *
301  END