LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ ssyconv()

subroutine ssyconv ( character  uplo,
character  way,
integer  n,
real, dimension( lda, * )  a,
integer  lda,
integer, dimension( * )  ipiv,
real, dimension( * )  e,
integer  info 
)

SSYCONV

Download SSYCONV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SSYCONV convert A given by TRF into L and D and vice-versa.
 Get Non-diag elements of D (returned in workspace) and
 apply or reverse permutation done in TRF.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the details of the factorization are stored
          as an upper or lower triangular matrix.
          = 'U':  Upper triangular, form is A = U*D*U**T;
          = 'L':  Lower triangular, form is A = L*D*L**T.
[in]WAY
          WAY is CHARACTER*1
          = 'C': Convert
          = 'R': Revert
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in,out]A
          A is REAL array, dimension (LDA,N)
          The block diagonal matrix D and the multipliers used to
          obtain the factor U or L as computed by SSYTRF.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[in]IPIV
          IPIV is INTEGER array, dimension (N)
          Details of the interchanges and the block structure of D
          as determined by SSYTRF.
[out]E
          E is REAL array, dimension (N)
          E stores the supdiagonal/subdiagonal of the symmetric 1-by-1
          or 2-by-2 block diagonal matrix D in LDLT.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 113 of file ssyconv.f.

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*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: