Annotation of rpl/lapack/lapack/zsyconvf_rook.f, revision 1.1
1.1 ! bertrand 1: *> \brief \b ZSYCONVF_ROOK
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download ZSYCONVF_ROOK + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconvf_rook.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconvf_rook.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconvf_rook.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE ZSYCONVF_ROOK( 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: * COMPLEX*16 A( LDA, * ), E( * )
! 30: * ..
! 31: *
! 32: *
! 33: *> \par Purpose:
! 34: * =============
! 35: *>
! 36: *> \verbatim
! 37: *> If parameter WAY = 'C':
! 38: *> ZSYCONVF_ROOK converts the factorization output format used in
! 39: *> ZSYTRF_ROOK provided on entry in parameter A into the factorization
! 40: *> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
! 41: *> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and
! 42: *> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
! 43: *>
! 44: *> If parameter WAY = 'R':
! 45: *> ZSYCONVF_ROOK performs the conversion in reverse direction, i.e.
! 46: *> converts the factorization output format used in ZSYTRF_RK
! 47: *> (or ZSYTRF_BK) provided on entry in parametes A and E into
! 48: *> the factorization output format used in ZSYTRF_ROOK that is stored
! 49: *> on exit in parameter A. IPIV format for ZSYTRF_ROOK and
! 50: *> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
! 51: *>
! 52: *> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between
! 53: *> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK).
! 54: *> \endverbatim
! 55: *
! 56: * Arguments:
! 57: * ==========
! 58: *
! 59: *> \param[in] UPLO
! 60: *> \verbatim
! 61: *> UPLO is CHARACTER*1
! 62: *> Specifies whether the details of the factorization are
! 63: *> stored as an upper or lower triangular matrix A.
! 64: *> = 'U': Upper triangular
! 65: *> = 'L': Lower triangular
! 66: *> \endverbatim
! 67: *>
! 68: *> \param[in] WAY
! 69: *> \verbatim
! 70: *> WAY is CHARACTER*1
! 71: *> = 'C': Convert
! 72: *> = 'R': Revert
! 73: *> \endverbatim
! 74: *>
! 75: *> \param[in] N
! 76: *> \verbatim
! 77: *> N is INTEGER
! 78: *> The order of the matrix A. N >= 0.
! 79: *> \endverbatim
! 80: *>
! 81: *> \param[in,out] A
! 82: *> \verbatim
! 83: *> A is COMPLEX*16 array, dimension (LDA,N)
! 84: *>
! 85: *> 1) If WAY ='C':
! 86: *>
! 87: *> On entry, contains factorization details in format used in
! 88: *> ZSYTRF_ROOK:
! 89: *> a) all elements of the symmetric block diagonal
! 90: *> matrix D on the diagonal of A and on superdiagonal
! 91: *> (or subdiagonal) of A, and
! 92: *> b) If UPLO = 'U': multipliers used to obtain factor U
! 93: *> in the superdiagonal part of A.
! 94: *> If UPLO = 'L': multipliers used to obtain factor L
! 95: *> in the superdiagonal part of A.
! 96: *>
! 97: *> On exit, contains factorization details in format used in
! 98: *> ZSYTRF_RK or ZSYTRF_BK:
! 99: *> a) ONLY diagonal elements of the symmetric block diagonal
! 100: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
! 101: *> (superdiagonal (or subdiagonal) elements of D
! 102: *> are stored on exit in array E), and
! 103: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
! 104: *> If UPLO = 'L': factor L in the subdiagonal part of A.
! 105: *>
! 106: *> 2) If WAY = 'R':
! 107: *>
! 108: *> On entry, contains factorization details in format used in
! 109: *> ZSYTRF_RK or ZSYTRF_BK:
! 110: *> a) ONLY diagonal elements of the symmetric block diagonal
! 111: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
! 112: *> (superdiagonal (or subdiagonal) elements of D
! 113: *> are stored on exit in array E), and
! 114: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
! 115: *> If UPLO = 'L': factor L in the subdiagonal part of A.
! 116: *>
! 117: *> On exit, contains factorization details in format used in
! 118: *> ZSYTRF_ROOK:
! 119: *> a) all elements of the symmetric block diagonal
! 120: *> matrix D on the diagonal of A and on superdiagonal
! 121: *> (or subdiagonal) of A, and
! 122: *> b) If UPLO = 'U': multipliers used to obtain factor U
! 123: *> in the superdiagonal part of A.
! 124: *> If UPLO = 'L': multipliers used to obtain factor L
! 125: *> in the superdiagonal part of A.
! 126: *> \endverbatim
! 127: *>
! 128: *> \param[in] LDA
! 129: *> \verbatim
! 130: *> LDA is INTEGER
! 131: *> The leading dimension of the array A. LDA >= max(1,N).
! 132: *> \endverbatim
! 133: *>
! 134: *> \param[in,out] E
! 135: *> \verbatim
! 136: *> E is COMPLEX*16 array, dimension (N)
! 137: *>
! 138: *> 1) If WAY ='C':
! 139: *>
! 140: *> On entry, just a workspace.
! 141: *>
! 142: *> On exit, contains the superdiagonal (or subdiagonal)
! 143: *> elements of the symmetric block diagonal matrix D
! 144: *> with 1-by-1 or 2-by-2 diagonal blocks, where
! 145: *> If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
! 146: *> If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
! 147: *>
! 148: *> 2) If WAY = 'R':
! 149: *>
! 150: *> On entry, contains the superdiagonal (or subdiagonal)
! 151: *> elements of the symmetric block diagonal matrix D
! 152: *> with 1-by-1 or 2-by-2 diagonal blocks, where
! 153: *> If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
! 154: *> If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
! 155: *>
! 156: *> On exit, is not changed
! 157: *> \endverbatim
! 158: *.
! 159: *> \param[in] IPIV
! 160: *> \verbatim
! 161: *> IPIV is INTEGER array, dimension (N)
! 162: *> On entry, details of the interchanges and the block
! 163: *> structure of D as determined:
! 164: *> 1) by ZSYTRF_ROOK, if WAY ='C';
! 165: *> 2) by ZSYTRF_RK (or ZSYTRF_BK), if WAY ='R'.
! 166: *> The IPIV format is the same for all these routines.
! 167: *>
! 168: *> On exit, is not changed.
! 169: *> \endverbatim
! 170: *>
! 171: *> \param[out] INFO
! 172: *> \verbatim
! 173: *> INFO is INTEGER
! 174: *> = 0: successful exit
! 175: *> < 0: if INFO = -i, the i-th argument had an illegal value
! 176: *> \endverbatim
! 177: *
! 178: * Authors:
! 179: * ========
! 180: *
! 181: *> \author Univ. of Tennessee
! 182: *> \author Univ. of California Berkeley
! 183: *> \author Univ. of Colorado Denver
! 184: *> \author NAG Ltd.
! 185: *
! 186: *> \date December 2016
! 187: *
! 188: *> \ingroup complex16SYcomputational
! 189: *
! 190: *> \par Contributors:
! 191: * ==================
! 192: *>
! 193: *> \verbatim
! 194: *>
! 195: *> December 2016, Igor Kozachenko,
! 196: *> Computer Science Division,
! 197: *> University of California, Berkeley
! 198: *>
! 199: *> \endverbatim
! 200: * =====================================================================
! 201: SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
! 202: *
! 203: * -- LAPACK computational routine (version 3.7.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: * December 2016
! 207: *
! 208: * .. Scalar Arguments ..
! 209: CHARACTER UPLO, WAY
! 210: INTEGER INFO, LDA, N
! 211: * ..
! 212: * .. Array Arguments ..
! 213: INTEGER IPIV( * )
! 214: COMPLEX*16 A( LDA, * ), E( * )
! 215: * ..
! 216: *
! 217: * =====================================================================
! 218: *
! 219: * .. Parameters ..
! 220: COMPLEX*16 ZERO
! 221: PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
! 222: * ..
! 223: * .. External Functions ..
! 224: LOGICAL LSAME
! 225: EXTERNAL LSAME
! 226: *
! 227: * .. External Subroutines ..
! 228: EXTERNAL ZSWAP, 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( 'ZSYCONVF_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 ZSWAP( 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 ZSWAP( 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 ZSWAP( 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 ZSWAP( 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 ZSWAP( 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 ZSWAP( 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 ZSWAP( 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 ZSWAP( I-1, A( I, 1 ), LDA,
! 460: $ A( IP, 1 ), LDA )
! 461: END IF
! 462: IF( IP2.NE.(I+1) ) THEN
! 463: CALL ZSWAP( 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 ZSWAP( 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 ZSWAP( I-1, A( IP2, 1 ), LDA,
! 512: $ A( I+1, 1 ), LDA )
! 513: END IF
! 514: IF( IP.NE.I ) THEN
! 515: CALL ZSWAP( 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 ZSYCONVF_ROOK
! 546: *
! 547: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zsyconvf_rook.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack