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

◆ zsyconvf_rook()

subroutine zsyconvf_rook ( character uplo,
character way,
integer n,
complex*16, dimension( lda, * ) a,
integer lda,
complex*16, dimension( * ) e,
integer, dimension( * ) ipiv,
integer info )

ZSYCONVF_ROOK

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

Purpose:
!> If parameter WAY = 'C':
!> ZSYCONVF_ROOK converts the factorization output format used in
!> ZSYTRF_ROOK provided on entry in parameter A into the factorization
!> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
!> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and
!> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
!>
!> If parameter WAY = 'R':
!> ZSYCONVF_ROOK performs the conversion in reverse direction, i.e.
!> converts the factorization output format used in ZSYTRF_RK
!> (or ZSYTRF_BK) provided on entry in parameters A and E into
!> the factorization output format used in ZSYTRF_ROOK that is stored
!> on exit in parameter A. IPIV format for ZSYTRF_ROOK and
!> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
!>
!> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between
!> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK).
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>          Specifies whether the details of the factorization are
!>          stored as an upper or lower triangular matrix A.
!>          = 'U':  Upper triangular
!>          = 'L':  Lower triangular
!>
[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 COMPLEX*16 array, dimension (LDA,N)
!>
!>          1) If WAY ='C':
!>
!>          On entry, contains factorization details in format used in
!>          ZSYTRF_ROOK:
!>            a) all elements of the symmetric block diagonal
!>               matrix D on the diagonal of A and on superdiagonal
!>               (or subdiagonal) of A, and
!>            b) If UPLO = 'U': multipliers used to obtain factor U
!>               in the superdiagonal part of A.
!>               If UPLO = 'L': multipliers used to obtain factor L
!>               in the superdiagonal part of A.
!>
!>          On exit, contains factorization details in format used in
!>          ZSYTRF_RK or ZSYTRF_BK:
!>            a) ONLY diagonal elements of the symmetric block diagonal
!>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
!>               (superdiagonal (or subdiagonal) elements of D
!>                are stored on exit in array E), and
!>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
!>               If UPLO = 'L': factor L in the subdiagonal part of A.
!>
!>          2) If WAY = 'R':
!>
!>          On entry, contains factorization details in format used in
!>          ZSYTRF_RK or ZSYTRF_BK:
!>            a) ONLY diagonal elements of the symmetric block diagonal
!>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
!>               (superdiagonal (or subdiagonal) elements of D
!>                are stored on exit in array E), and
!>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
!>               If UPLO = 'L': factor L in the subdiagonal part of A.
!>
!>          On exit, contains factorization details in format used in
!>          ZSYTRF_ROOK:
!>            a) all elements of the symmetric block diagonal
!>               matrix D on the diagonal of A and on superdiagonal
!>               (or subdiagonal) of A, and
!>            b) If UPLO = 'U': multipliers used to obtain factor U
!>               in the superdiagonal part of A.
!>               If UPLO = 'L': multipliers used to obtain factor L
!>               in the superdiagonal part of A.
!>
[in]LDA
!>          LDA is INTEGER
!>          The leading dimension of the array A.  LDA >= max(1,N).
!>
[in,out]E
!>          E is COMPLEX*16 array, dimension (N)
!>
!>          1) If WAY ='C':
!>
!>          On entry, just a workspace.
!>
!>          On exit, contains the superdiagonal (or subdiagonal)
!>          elements of the symmetric block diagonal matrix D
!>          with 1-by-1 or 2-by-2 diagonal blocks, where
!>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
!>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
!>
!>          2) If WAY = 'R':
!>
!>          On entry, contains the superdiagonal (or subdiagonal)
!>          elements of the symmetric block diagonal matrix D
!>          with 1-by-1 or 2-by-2 diagonal blocks, where
!>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
!>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
!>
!>          On exit, is not changed
!>
[in]IPIV
!>          IPIV is INTEGER array, dimension (N)
!>          On entry, details of the interchanges and the block
!>          structure of D as determined:
!>          1) by ZSYTRF_ROOK, if WAY ='C';
!>          2) by ZSYTRF_RK (or ZSYTRF_BK), if WAY ='R'.
!>          The IPIV format is the same for all these routines.
!>
!>          On exit, is not changed.
!>
[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.
Contributors:
!>
!>  November 2017,  Igor Kozachenko,
!>                  Computer Science Division,
!>                  University of California, Berkeley
!>
!>

Definition at line 197 of file zsyconvf_rook.f.

198*
199* -- LAPACK computational routine --
200* -- LAPACK is a software package provided by Univ. of Tennessee, --
201* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202*
203* .. Scalar Arguments ..
204 CHARACTER UPLO, WAY
205 INTEGER INFO, LDA, N
206* ..
207* .. Array Arguments ..
208 INTEGER IPIV( * )
209 COMPLEX*16 A( LDA, * ), E( * )
210* ..
211*
212* =====================================================================
213*
214* .. Parameters ..
215 COMPLEX*16 ZERO
216 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
217* ..
218* .. External Functions ..
219 LOGICAL LSAME
220 EXTERNAL lsame
221*
222* .. External Subroutines ..
223 EXTERNAL zswap, xerbla
224* .. Local Scalars ..
225 LOGICAL UPPER, CONVERT
226 INTEGER I, IP, IP2
227* ..
228* .. Executable Statements ..
229*
230 info = 0
231 upper = lsame( uplo, 'U' )
232 convert = lsame( way, 'C' )
233 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
234 info = -1
235 ELSE IF( .NOT.convert .AND. .NOT.lsame( way, 'R' ) ) THEN
236 info = -2
237 ELSE IF( n.LT.0 ) THEN
238 info = -3
239 ELSE IF( lda.LT.max( 1, n ) ) THEN
240 info = -5
241
242 END IF
243 IF( info.NE.0 ) THEN
244 CALL xerbla( 'ZSYCONVF_ROOK', -info )
245 RETURN
246 END IF
247*
248* Quick return if possible
249*
250 IF( n.EQ.0 )
251 $ RETURN
252*
253 IF( upper ) THEN
254*
255* Begin A is UPPER
256*
257 IF ( convert ) THEN
258*
259* Convert A (A is upper)
260*
261*
262* Convert VALUE
263*
264* Assign superdiagonal entries of D to array E and zero out
265* corresponding entries in input storage A
266*
267 i = n
268 e( 1 ) = zero
269 DO WHILE ( i.GT.1 )
270 IF( ipiv( i ).LT.0 ) THEN
271 e( i ) = a( i-1, i )
272 e( i-1 ) = zero
273 a( i-1, i ) = zero
274 i = i - 1
275 ELSE
276 e( i ) = zero
277 END IF
278 i = i - 1
279 END DO
280*
281* Convert PERMUTATIONS
282*
283* Apply permutations to submatrices of upper part of A
284* in factorization order where i decreases from N to 1
285*
286 i = n
287 DO WHILE ( i.GE.1 )
288 IF( ipiv( i ).GT.0 ) THEN
289*
290* 1-by-1 pivot interchange
291*
292* Swap rows i and IPIV(i) in A(1:i,N-i:N)
293*
294 ip = ipiv( i )
295 IF( i.LT.n ) THEN
296 IF( ip.NE.i ) THEN
297 CALL zswap( n-i, a( i, i+1 ), lda,
298 $ a( ip, i+1 ), lda )
299 END IF
300 END IF
301*
302 ELSE
303*
304* 2-by-2 pivot interchange
305*
306* Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
307* in A(1:i,N-i:N)
308*
309 ip = -ipiv( i )
310 ip2 = -ipiv( i-1 )
311 IF( i.LT.n ) THEN
312 IF( ip.NE.i ) THEN
313 CALL zswap( n-i, a( i, i+1 ), lda,
314 $ a( ip, i+1 ), lda )
315 END IF
316 IF( ip2.NE.(i-1) ) THEN
317 CALL zswap( n-i, a( i-1, i+1 ), lda,
318 $ a( ip2, i+1 ), lda )
319 END IF
320 END IF
321 i = i - 1
322*
323 END IF
324 i = i - 1
325 END DO
326*
327 ELSE
328*
329* Revert A (A is upper)
330*
331*
332* Revert PERMUTATIONS
333*
334* Apply permutations to submatrices of upper part of A
335* in reverse factorization order where i increases from 1 to N
336*
337 i = 1
338 DO WHILE ( i.LE.n )
339 IF( ipiv( i ).GT.0 ) THEN
340*
341* 1-by-1 pivot interchange
342*
343* Swap rows i and IPIV(i) in A(1:i,N-i:N)
344*
345 ip = ipiv( i )
346 IF( i.LT.n ) THEN
347 IF( ip.NE.i ) THEN
348 CALL zswap( n-i, a( ip, i+1 ), lda,
349 $ a( i, i+1 ), lda )
350 END IF
351 END IF
352*
353 ELSE
354*
355* 2-by-2 pivot interchange
356*
357* Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
358* in A(1:i,N-i:N)
359*
360 i = i + 1
361 ip = -ipiv( i )
362 ip2 = -ipiv( i-1 )
363 IF( i.LT.n ) THEN
364 IF( ip2.NE.(i-1) ) THEN
365 CALL zswap( n-i, a( ip2, i+1 ), lda,
366 $ a( i-1, i+1 ), lda )
367 END IF
368 IF( ip.NE.i ) THEN
369 CALL zswap( n-i, a( ip, i+1 ), lda,
370 $ a( i, i+1 ), lda )
371 END IF
372 END IF
373*
374 END IF
375 i = i + 1
376 END DO
377*
378* Revert VALUE
379* Assign superdiagonal entries of D from array E to
380* superdiagonal entries of A.
381*
382 i = n
383 DO WHILE ( i.GT.1 )
384 IF( ipiv( i ).LT.0 ) THEN
385 a( i-1, i ) = e( i )
386 i = i - 1
387 END IF
388 i = i - 1
389 END DO
390*
391* End A is UPPER
392*
393 END IF
394*
395 ELSE
396*
397* Begin A is LOWER
398*
399 IF ( convert ) THEN
400*
401* Convert A (A is lower)
402*
403*
404* Convert VALUE
405* Assign subdiagonal entries of D to array E and zero out
406* corresponding entries in input storage A
407*
408 i = 1
409 e( n ) = zero
410 DO WHILE ( i.LE.n )
411 IF( i.LT.n .AND. ipiv(i).LT.0 ) THEN
412 e( i ) = a( i+1, i )
413 e( i+1 ) = zero
414 a( i+1, i ) = zero
415 i = i + 1
416 ELSE
417 e( i ) = zero
418 END IF
419 i = i + 1
420 END DO
421*
422* Convert PERMUTATIONS
423*
424* Apply permutations to submatrices of lower part of A
425* in factorization order where i increases from 1 to N
426*
427 i = 1
428 DO WHILE ( i.LE.n )
429 IF( ipiv( i ).GT.0 ) THEN
430*
431* 1-by-1 pivot interchange
432*
433* Swap rows i and IPIV(i) in A(i:N,1:i-1)
434*
435 ip = ipiv( i )
436 IF ( i.GT.1 ) THEN
437 IF( ip.NE.i ) THEN
438 CALL zswap( i-1, a( i, 1 ), lda,
439 $ a( ip, 1 ), lda )
440 END IF
441 END IF
442*
443 ELSE
444*
445* 2-by-2 pivot interchange
446*
447* Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
448* in A(i:N,1:i-1)
449*
450 ip = -ipiv( i )
451 ip2 = -ipiv( i+1 )
452 IF ( i.GT.1 ) THEN
453 IF( ip.NE.i ) THEN
454 CALL zswap( i-1, a( i, 1 ), lda,
455 $ a( ip, 1 ), lda )
456 END IF
457 IF( ip2.NE.(i+1) ) THEN
458 CALL zswap( i-1, a( i+1, 1 ), lda,
459 $ a( ip2, 1 ), lda )
460 END IF
461 END IF
462 i = i + 1
463*
464 END IF
465 i = i + 1
466 END DO
467*
468 ELSE
469*
470* Revert A (A is lower)
471*
472*
473* Revert PERMUTATIONS
474*
475* Apply permutations to submatrices of lower part of A
476* in reverse factorization order where i decreases from N to 1
477*
478 i = n
479 DO WHILE ( i.GE.1 )
480 IF( ipiv( i ).GT.0 ) THEN
481*
482* 1-by-1 pivot interchange
483*
484* Swap rows i and IPIV(i) in A(i:N,1:i-1)
485*
486 ip = ipiv( i )
487 IF ( i.GT.1 ) THEN
488 IF( ip.NE.i ) THEN
489 CALL zswap( i-1, a( ip, 1 ), lda,
490 $ a( i, 1 ), lda )
491 END IF
492 END IF
493*
494 ELSE
495*
496* 2-by-2 pivot interchange
497*
498* Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
499* in A(i:N,1:i-1)
500*
501 i = i - 1
502 ip = -ipiv( i )
503 ip2 = -ipiv( i+1 )
504 IF ( i.GT.1 ) THEN
505 IF( ip2.NE.(i+1) ) THEN
506 CALL zswap( i-1, a( ip2, 1 ), lda,
507 $ a( i+1, 1 ), lda )
508 END IF
509 IF( ip.NE.i ) THEN
510 CALL zswap( i-1, a( ip, 1 ), lda,
511 $ a( i, 1 ), lda )
512 END IF
513 END IF
514*
515 END IF
516 i = i - 1
517 END DO
518*
519* Revert VALUE
520* Assign subdiagonal entries of D from array E to
521* subdiagonal entries of A.
522*
523 i = 1
524 DO WHILE ( i.LE.n-1 )
525 IF( ipiv( i ).LT.0 ) THEN
526 a( i + 1, i ) = e( i )
527 i = i + 1
528 END IF
529 i = i + 1
530 END DO
531*
532 END IF
533*
534* End A is LOWER
535*
536 END IF
537
538 RETURN
539*
540* End of ZSYCONVF_ROOK
541*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
zswap
subroutine zswap(n, zx, incx, zy, incy)
ZSWAP
Definition zswap.f:81
Here is the call graph for this function:
Here is the caller graph for this function: