LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ssyconv.f
Go to the documentation of this file.
1*> \brief \b SSYCONV
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SSYCONV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyconv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyconv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyconv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO, WAY
25* INTEGER INFO, LDA, N
26* ..
27* .. Array Arguments ..
28* INTEGER IPIV( * )
29* REAL A( LDA, * ), E( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> SSYCONV convert A given by TRF into L and D and vice-versa.
39*> Get Non-diag elements of D (returned in workspace) and
40*> apply or reverse permutation done in TRF.
41*> \endverbatim
42*
43* Arguments:
44* ==========
45*
46*> \param[in] UPLO
47*> \verbatim
48*> UPLO is CHARACTER*1
49*> Specifies whether the details of the factorization are stored
50*> as an upper or lower triangular matrix.
51*> = 'U': Upper triangular, form is A = U*D*U**T;
52*> = 'L': Lower triangular, form is A = L*D*L**T.
53*> \endverbatim
54*>
55*> \param[in] WAY
56*> \verbatim
57*> WAY is CHARACTER*1
58*> = 'C': Convert
59*> = 'R': Revert
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*> N is INTEGER
65*> The order of the matrix A. N >= 0.
66*> \endverbatim
67*>
68*> \param[in,out] A
69*> \verbatim
70*> A is REAL array, dimension (LDA,N)
71*> The block diagonal matrix D and the multipliers used to
72*> obtain the factor U or L as computed by SSYTRF.
73*> \endverbatim
74*>
75*> \param[in] LDA
76*> \verbatim
77*> LDA is INTEGER
78*> The leading dimension of the array A. LDA >= max(1,N).
79*> \endverbatim
80*>
81*> \param[in] IPIV
82*> \verbatim
83*> IPIV is INTEGER array, dimension (N)
84*> Details of the interchanges and the block structure of D
85*> as determined by SSYTRF.
86*> \endverbatim
87*>
88*> \param[out] E
89*> \verbatim
90*> E is REAL array, dimension (N)
91*> E stores the supdiagonal/subdiagonal of the symmetric 1-by-1
92*> or 2-by-2 block diagonal matrix D in LDLT.
93*> \endverbatim
94*>
95*> \param[out] INFO
96*> \verbatim
97*> INFO is INTEGER
98*> = 0: successful exit
99*> < 0: if INFO = -i, the i-th argument had an illegal value
100*> \endverbatim
101*
102* Authors:
103* ========
104*
105*> \author Univ. of Tennessee
106*> \author Univ. of California Berkeley
107*> \author Univ. of Colorado Denver
108*> \author NAG Ltd.
109*
110*> \ingroup syconv
111*
112* =====================================================================
113 SUBROUTINE ssyconv( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
114*
115* -- LAPACK computational routine --
116* -- LAPACK is a software package provided by Univ. of Tennessee, --
117* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
118*
119* .. Scalar Arguments ..
120 CHARACTER UPLO, WAY
121 INTEGER INFO, LDA, N
122* ..
123* .. Array Arguments ..
124 INTEGER IPIV( * )
125 REAL A( LDA, * ), E( * )
126* ..
127*
128* =====================================================================
129*
130* .. Parameters ..
131 REAL ZERO
132 parameter( zero = 0.0e+0 )
133* ..
134* .. External Functions ..
135 LOGICAL LSAME
136 EXTERNAL lsame
137*
138* .. External Subroutines ..
139 EXTERNAL xerbla
140* .. Local Scalars ..
141 LOGICAL UPPER, CONVERT
142 INTEGER I, IP, J
143 REAL TEMP
144* ..
145* .. Executable Statements ..
146*
147 info = 0
148 upper = lsame( uplo, 'U' )
149 convert = lsame( way, 'C' )
150 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
151 info = -1
152 ELSE IF( .NOT.convert .AND. .NOT.lsame( way, 'R' ) ) THEN
153 info = -2
154 ELSE IF( n.LT.0 ) THEN
155 info = -3
156 ELSE IF( lda.LT.max( 1, n ) ) THEN
157 info = -5
158
159 END IF
160 IF( info.NE.0 ) THEN
161 CALL xerbla( 'SSYCONV', -info )
162 RETURN
163 END IF
164*
165* Quick return if possible
166*
167 IF( n.EQ.0 )
168 $ RETURN
169*
170 IF( upper ) THEN
171*
172* A is UPPER
173*
174* Convert A (A is upper)
175*
176* Convert VALUE
177*
178 IF ( convert ) THEN
179 i=n
180 e(1)=zero
181 DO WHILE ( i .GT. 1 )
182 IF( ipiv(i) .LT. 0 ) THEN
183 e(i)=a(i-1,i)
184 e(i-1)=zero
185 a(i-1,i)=zero
186 i=i-1
187 ELSE
188 e(i)=zero
189 ENDIF
190 i=i-1
191 END DO
192*
193* Convert PERMUTATIONS
194*
195 i=n
196 DO WHILE ( i .GE. 1 )
197 IF( ipiv(i) .GT. 0) THEN
198 ip=ipiv(i)
199 IF( i .LT. n) THEN
200 DO 12 j= i+1,n
201 temp=a(ip,j)
202 a(ip,j)=a(i,j)
203 a(i,j)=temp
204 12 CONTINUE
205 ENDIF
206 ELSE
207 ip=-ipiv(i)
208 IF( i .LT. n) THEN
209 DO 13 j= i+1,n
210 temp=a(ip,j)
211 a(ip,j)=a(i-1,j)
212 a(i-1,j)=temp
213 13 CONTINUE
214 ENDIF
215 i=i-1
216 ENDIF
217 i=i-1
218 END DO
219
220 ELSE
221*
222* Revert A (A is upper)
223*
224*
225* Revert PERMUTATIONS
226*
227 i=1
228 DO WHILE ( i .LE. n )
229 IF( ipiv(i) .GT. 0 ) THEN
230 ip=ipiv(i)
231 IF( i .LT. n) THEN
232 DO j= i+1,n
233 temp=a(ip,j)
234 a(ip,j)=a(i,j)
235 a(i,j)=temp
236 END DO
237 ENDIF
238 ELSE
239 ip=-ipiv(i)
240 i=i+1
241 IF( i .LT. n) THEN
242 DO j= i+1,n
243 temp=a(ip,j)
244 a(ip,j)=a(i-1,j)
245 a(i-1,j)=temp
246 END DO
247 ENDIF
248 ENDIF
249 i=i+1
250 END DO
251*
252* Revert VALUE
253*
254 i=n
255 DO WHILE ( i .GT. 1 )
256 IF( ipiv(i) .LT. 0 ) THEN
257 a(i-1,i)=e(i)
258 i=i-1
259 ENDIF
260 i=i-1
261 END DO
262 END IF
263 ELSE
264*
265* A is LOWER
266*
267 IF ( convert ) THEN
268*
269* Convert A (A is lower)
270*
271*
272* Convert VALUE
273*
274 i=1
275 e(n)=zero
276 DO WHILE ( i .LE. n )
277 IF( i.LT.n .AND. ipiv(i) .LT. 0 ) THEN
278 e(i)=a(i+1,i)
279 e(i+1)=zero
280 a(i+1,i)=zero
281 i=i+1
282 ELSE
283 e(i)=zero
284 ENDIF
285 i=i+1
286 END DO
287*
288* Convert PERMUTATIONS
289*
290 i=1
291 DO WHILE ( i .LE. n )
292 IF( ipiv(i) .GT. 0 ) THEN
293 ip=ipiv(i)
294 IF (i .GT. 1) THEN
295 DO 22 j= 1,i-1
296 temp=a(ip,j)
297 a(ip,j)=a(i,j)
298 a(i,j)=temp
299 22 CONTINUE
300 ENDIF
301 ELSE
302 ip=-ipiv(i)
303 IF (i .GT. 1) THEN
304 DO 23 j= 1,i-1
305 temp=a(ip,j)
306 a(ip,j)=a(i+1,j)
307 a(i+1,j)=temp
308 23 CONTINUE
309 ENDIF
310 i=i+1
311 ENDIF
312 i=i+1
313 END DO
314 ELSE
315*
316* Revert A (A is lower)
317*
318*
319* Revert PERMUTATIONS
320*
321 i=n
322 DO WHILE ( i .GE. 1 )
323 IF( ipiv(i) .GT. 0 ) THEN
324 ip=ipiv(i)
325 IF (i .GT. 1) THEN
326 DO j= 1,i-1
327 temp=a(i,j)
328 a(i,j)=a(ip,j)
329 a(ip,j)=temp
330 END DO
331 ENDIF
332 ELSE
333 ip=-ipiv(i)
334 i=i-1
335 IF (i .GT. 1) THEN
336 DO j= 1,i-1
337 temp=a(i+1,j)
338 a(i+1,j)=a(ip,j)
339 a(ip,j)=temp
340 END DO
341 ENDIF
342 ENDIF
343 i=i-1
344 END DO
345*
346* Revert VALUE
347*
348 i=1
349 DO WHILE ( i .LE. n-1 )
350 IF( ipiv(i) .LT. 0 ) THEN
351 a(i+1,i)=e(i)
352 i=i+1
353 ENDIF
354 i=i+1
355 END DO
356 END IF
357 END IF
358
359 RETURN
360*
361* End of SSYCONV
362*
363 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine ssyconv(uplo, way, n, a, lda, ipiv, e, info)
SSYCONV
Definition ssyconv.f:114