LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ csyconvf_rook()

subroutine csyconvf_rook ( character  UPLO,
character  WAY,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( * )  E,
integer, dimension( * )  IPIV,
integer  INFO 
)

CSYCONVF_ROOK

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

Purpose:
 If parameter WAY = 'C':
 CSYCONVF_ROOK converts the factorization output format used in
 CSYTRF_ROOK provided on entry in parameter A into the factorization
 output format used in CSYTRF_RK (or CSYTRF_BK) that is stored
 on exit in parameters A and E. IPIV format for CSYTRF_ROOK and
 CSYTRF_RK (or CSYTRF_BK) is the same and is not converted.

 If parameter WAY = 'R':
 CSYCONVF_ROOK performs the conversion in reverse direction, i.e.
 converts the factorization output format used in CSYTRF_RK
 (or CSYTRF_BK) provided on entry in parameters A and E into
 the factorization output format used in CSYTRF_ROOK that is stored
 on exit in parameter A. IPIV format for CSYTRF_ROOK and
 CSYTRF_RK (or CSYTRF_BK) is the same and is not converted.

 CSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between
 formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_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 array, dimension (LDA,N)

          1) If WAY ='C':

          On entry, contains factorization details in format used in
          CSYTRF_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
          CSYTRF_RK or CSYTRF_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
          CSYTRF_RK or CSYTRF_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
          CSYTRF_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 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 CSYTRF_ROOK, if WAY ='C';
          2) by CSYTRF_RK (or CSYTRF_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.
Date
November 2017
Contributors:
  November 2017,  Igor Kozachenko,
                  Computer Science Division,
                  University of California, Berkeley

Definition at line 202 of file csyconvf_rook.f.

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