Annotation of rpl/lapack/lapack/dsyconvf_rook.f, revision 1.1
1.1 ! bertrand 1: *> \brief \b DSYCONVF_ROOK
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download DSYCONVF_ROOK + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyconvf_rook.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyconvf_rook.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyconvf_rook.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE DSYCONVF_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: * DOUBLE PRECISION A( LDA, * ), E( * )
! 30: * ..
! 31: *
! 32: *
! 33: *> \par Purpose:
! 34: * =============
! 35: *>
! 36: *> \verbatim
! 37: *> If parameter WAY = 'C':
! 38: *> DSYCONVF_ROOK converts the factorization output format used in
! 39: *> DSYTRF_ROOK provided on entry in parameter A into the factorization
! 40: *> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored
! 41: *> on exit in parameters A and E. IPIV format for DSYTRF_ROOK and
! 42: *> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted.
! 43: *>
! 44: *> If parameter WAY = 'R':
! 45: *> DSYCONVF_ROOK performs the conversion in reverse direction, i.e.
! 46: *> converts the factorization output format used in DSYTRF_RK
! 47: *> (or DSYTRF_BK) provided on entry in parametes A and E into
! 48: *> the factorization output format used in DSYTRF_ROOK that is stored
! 49: *> on exit in parameter A. IPIV format for DSYTRF_ROOK and
! 50: *> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted.
! 51: *> \endverbatim
! 52: *
! 53: * Arguments:
! 54: * ==========
! 55: *
! 56: *> \param[in] UPLO
! 57: *> \verbatim
! 58: *> UPLO is CHARACTER*1
! 59: *> Specifies whether the details of the factorization are
! 60: *> stored as an upper or lower triangular matrix A.
! 61: *> = 'U': Upper triangular
! 62: *> = 'L': Lower triangular
! 63: *> \endverbatim
! 64: *>
! 65: *> \param[in] WAY
! 66: *> \verbatim
! 67: *> WAY is CHARACTER*1
! 68: *> = 'C': Convert
! 69: *> = 'R': Revert
! 70: *> \endverbatim
! 71: *>
! 72: *> \param[in] N
! 73: *> \verbatim
! 74: *> N is INTEGER
! 75: *> The order of the matrix A. N >= 0.
! 76: *> \endverbatim
! 77: *>
! 78: *> \param[in,out] A
! 79: *> \verbatim
! 80: *> A is DOUBLE PRECISION array, dimension (LDA,N)
! 81: *>
! 82: *> 1) If WAY ='C':
! 83: *>
! 84: *> On entry, contains factorization details in format used in
! 85: *> DSYTRF_ROOK:
! 86: *> a) all elements of the symmetric block diagonal
! 87: *> matrix D on the diagonal of A and on superdiagonal
! 88: *> (or subdiagonal) of A, and
! 89: *> b) If UPLO = 'U': multipliers used to obtain factor U
! 90: *> in the superdiagonal part of A.
! 91: *> If UPLO = 'L': multipliers used to obtain factor L
! 92: *> in the superdiagonal part of A.
! 93: *>
! 94: *> On exit, contains factorization details in format used in
! 95: *> DSYTRF_RK or DSYTRF_BK:
! 96: *> a) ONLY diagonal elements of the symmetric block diagonal
! 97: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
! 98: *> (superdiagonal (or subdiagonal) elements of D
! 99: *> are stored on exit in array E), and
! 100: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
! 101: *> If UPLO = 'L': factor L in the subdiagonal part of A.
! 102: *>
! 103: *> 2) If WAY = 'R':
! 104: *>
! 105: *> On entry, contains factorization details in format used in
! 106: *> DSYTRF_RK or DSYTRF_BK:
! 107: *> a) ONLY diagonal elements of the symmetric block diagonal
! 108: *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
! 109: *> (superdiagonal (or subdiagonal) elements of D
! 110: *> are stored on exit in array E), and
! 111: *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
! 112: *> If UPLO = 'L': factor L in the subdiagonal part of A.
! 113: *>
! 114: *> On exit, contains factorization details in format used in
! 115: *> DSYTRF_ROOK:
! 116: *> a) all elements of the symmetric block diagonal
! 117: *> matrix D on the diagonal of A and on superdiagonal
! 118: *> (or subdiagonal) of A, and
! 119: *> b) If UPLO = 'U': multipliers used to obtain factor U
! 120: *> in the superdiagonal part of A.
! 121: *> If UPLO = 'L': multipliers used to obtain factor L
! 122: *> in the superdiagonal part of A.
! 123: *> \endverbatim
! 124: *>
! 125: *> \param[in] LDA
! 126: *> \verbatim
! 127: *> LDA is INTEGER
! 128: *> The leading dimension of the array A. LDA >= max(1,N).
! 129: *> \endverbatim
! 130: *>
! 131: *> \param[in,out] E
! 132: *> \verbatim
! 133: *> E is DOUBLE PRECISION array, dimension (N)
! 134: *>
! 135: *> 1) If WAY ='C':
! 136: *>
! 137: *> On entry, just a workspace.
! 138: *>
! 139: *> On exit, contains the superdiagonal (or subdiagonal)
! 140: *> elements of the symmetric block diagonal matrix D
! 141: *> with 1-by-1 or 2-by-2 diagonal blocks, where
! 142: *> If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
! 143: *> If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
! 144: *>
! 145: *> 2) If WAY = 'R':
! 146: *>
! 147: *> On entry, contains the superdiagonal (or subdiagonal)
! 148: *> elements of the symmetric block diagonal matrix D
! 149: *> with 1-by-1 or 2-by-2 diagonal blocks, where
! 150: *> If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
! 151: *> If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
! 152: *>
! 153: *> On exit, is not changed
! 154: *> \endverbatim
! 155: *.
! 156: *> \param[in] IPIV
! 157: *> \verbatim
! 158: *> IPIV is INTEGER array, dimension (N)
! 159: *> On entry, details of the interchanges and the block
! 160: *> structure of D as determined:
! 161: *> 1) by DSYTRF_ROOK, if WAY ='C';
! 162: *> 2) by DSYTRF_RK (or DSYTRF_BK), if WAY ='R'.
! 163: *> The IPIV format is the same for all these routines.
! 164: *>
! 165: *> On exit, is not changed.
! 166: *> \endverbatim
! 167: *>
! 168: *> \param[out] INFO
! 169: *> \verbatim
! 170: *> INFO is INTEGER
! 171: *> = 0: successful exit
! 172: *> < 0: if INFO = -i, the i-th argument had an illegal value
! 173: *> \endverbatim
! 174: *
! 175: * Authors:
! 176: * ========
! 177: *
! 178: *> \author Univ. of Tennessee
! 179: *> \author Univ. of California Berkeley
! 180: *> \author Univ. of Colorado Denver
! 181: *> \author NAG Ltd.
! 182: *
! 183: *> \date December 2016
! 184: *
! 185: *> \ingroup doubleSYcomputational
! 186: *
! 187: *> \par Contributors:
! 188: * ==================
! 189: *>
! 190: *> \verbatim
! 191: *>
! 192: *> December 2016, Igor Kozachenko,
! 193: *> Computer Science Division,
! 194: *> University of California, Berkeley
! 195: *>
! 196: *> \endverbatim
! 197: * =====================================================================
! 198: SUBROUTINE DSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
! 199: *
! 200: * -- LAPACK computational routine (version 3.7.0) --
! 201: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 202: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 203: * December 2016
! 204: *
! 205: * .. Scalar Arguments ..
! 206: CHARACTER UPLO, WAY
! 207: INTEGER INFO, LDA, N
! 208: * ..
! 209: * .. Array Arguments ..
! 210: INTEGER IPIV( * )
! 211: DOUBLE PRECISION A( LDA, * ), E( * )
! 212: * ..
! 213: *
! 214: * =====================================================================
! 215: *
! 216: * .. Parameters ..
! 217: DOUBLE PRECISION ZERO
! 218: PARAMETER ( ZERO = 0.0D+0 )
! 219: * ..
! 220: * .. External Functions ..
! 221: LOGICAL LSAME
! 222: EXTERNAL LSAME
! 223: *
! 224: * .. External Subroutines ..
! 225: EXTERNAL DSWAP, XERBLA
! 226: * .. Local Scalars ..
! 227: LOGICAL UPPER, CONVERT
! 228: INTEGER I, IP, IP2
! 229: * ..
! 230: * .. Executable Statements ..
! 231: *
! 232: INFO = 0
! 233: UPPER = LSAME( UPLO, 'U' )
! 234: CONVERT = LSAME( WAY, 'C' )
! 235: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
! 236: INFO = -1
! 237: ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
! 238: INFO = -2
! 239: ELSE IF( N.LT.0 ) THEN
! 240: INFO = -3
! 241: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
! 242: INFO = -5
! 243:
! 244: END IF
! 245: IF( INFO.NE.0 ) THEN
! 246: CALL XERBLA( 'DSYCONVF_ROOK', -INFO )
! 247: RETURN
! 248: END IF
! 249: *
! 250: * Quick return if possible
! 251: *
! 252: IF( N.EQ.0 )
! 253: $ RETURN
! 254: *
! 255: IF( UPPER ) THEN
! 256: *
! 257: * Begin A is UPPER
! 258: *
! 259: IF ( CONVERT ) THEN
! 260: *
! 261: * Convert A (A is upper)
! 262: *
! 263: *
! 264: * Convert VALUE
! 265: *
! 266: * Assign superdiagonal entries of D to array E and zero out
! 267: * corresponding entries in input storage A
! 268: *
! 269: I = N
! 270: E( 1 ) = ZERO
! 271: DO WHILE ( I.GT.1 )
! 272: IF( IPIV( I ).LT.0 ) THEN
! 273: E( I ) = A( I-1, I )
! 274: E( I-1 ) = ZERO
! 275: A( I-1, I ) = ZERO
! 276: I = I - 1
! 277: ELSE
! 278: E( I ) = ZERO
! 279: END IF
! 280: I = I - 1
! 281: END DO
! 282: *
! 283: * Convert PERMUTATIONS
! 284: *
! 285: * Apply permutaions to submatrices of upper part of A
! 286: * in factorization order where i decreases from N to 1
! 287: *
! 288: I = N
! 289: DO WHILE ( I.GE.1 )
! 290: IF( IPIV( I ).GT.0 ) THEN
! 291: *
! 292: * 1-by-1 pivot interchange
! 293: *
! 294: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
! 295: *
! 296: IP = IPIV( I )
! 297: IF( I.LT.N ) THEN
! 298: IF( IP.NE.I ) THEN
! 299: CALL DSWAP( N-I, A( I, I+1 ), LDA,
! 300: $ A( IP, I+1 ), LDA )
! 301: END IF
! 302: END IF
! 303: *
! 304: ELSE
! 305: *
! 306: * 2-by-2 pivot interchange
! 307: *
! 308: * Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
! 309: * in A(1:i,N-i:N)
! 310: *
! 311: IP = -IPIV( I )
! 312: IP2 = -IPIV( I-1 )
! 313: IF( I.LT.N ) THEN
! 314: IF( IP.NE.I ) THEN
! 315: CALL DSWAP( N-I, A( I, I+1 ), LDA,
! 316: $ A( IP, I+1 ), LDA )
! 317: END IF
! 318: IF( IP2.NE.(I-1) ) THEN
! 319: CALL DSWAP( N-I, A( I-1, I+1 ), LDA,
! 320: $ A( IP2, I+1 ), LDA )
! 321: END IF
! 322: END IF
! 323: I = I - 1
! 324: *
! 325: END IF
! 326: I = I - 1
! 327: END DO
! 328: *
! 329: ELSE
! 330: *
! 331: * Revert A (A is upper)
! 332: *
! 333: *
! 334: * Revert PERMUTATIONS
! 335: *
! 336: * Apply permutaions to submatrices of upper part of A
! 337: * in reverse factorization order where i increases from 1 to N
! 338: *
! 339: I = 1
! 340: DO WHILE ( I.LE.N )
! 341: IF( IPIV( I ).GT.0 ) THEN
! 342: *
! 343: * 1-by-1 pivot interchange
! 344: *
! 345: * Swap rows i and IPIV(i) in A(1:i,N-i:N)
! 346: *
! 347: IP = IPIV( I )
! 348: IF( I.LT.N ) THEN
! 349: IF( IP.NE.I ) THEN
! 350: CALL DSWAP( N-I, A( IP, I+1 ), LDA,
! 351: $ A( I, I+1 ), LDA )
! 352: END IF
! 353: END IF
! 354: *
! 355: ELSE
! 356: *
! 357: * 2-by-2 pivot interchange
! 358: *
! 359: * Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
! 360: * in A(1:i,N-i:N)
! 361: *
! 362: I = I + 1
! 363: IP = -IPIV( I )
! 364: IP2 = -IPIV( I-1 )
! 365: IF( I.LT.N ) THEN
! 366: IF( IP2.NE.(I-1) ) THEN
! 367: CALL DSWAP( N-I, A( IP2, I+1 ), LDA,
! 368: $ A( I-1, I+1 ), LDA )
! 369: END IF
! 370: IF( IP.NE.I ) THEN
! 371: CALL DSWAP( N-I, A( IP, I+1 ), LDA,
! 372: $ A( I, I+1 ), LDA )
! 373: END IF
! 374: END IF
! 375: *
! 376: END IF
! 377: I = I + 1
! 378: END DO
! 379: *
! 380: * Revert VALUE
! 381: * Assign superdiagonal entries of D from array E to
! 382: * superdiagonal entries of A.
! 383: *
! 384: I = N
! 385: DO WHILE ( I.GT.1 )
! 386: IF( IPIV( I ).LT.0 ) THEN
! 387: A( I-1, I ) = E( I )
! 388: I = I - 1
! 389: END IF
! 390: I = I - 1
! 391: END DO
! 392: *
! 393: * End A is UPPER
! 394: *
! 395: END IF
! 396: *
! 397: ELSE
! 398: *
! 399: * Begin A is LOWER
! 400: *
! 401: IF ( CONVERT ) THEN
! 402: *
! 403: * Convert A (A is lower)
! 404: *
! 405: *
! 406: * Convert VALUE
! 407: * Assign subdiagonal entries of D to array E and zero out
! 408: * corresponding entries in input storage A
! 409: *
! 410: I = 1
! 411: E( N ) = ZERO
! 412: DO WHILE ( I.LE.N )
! 413: IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
! 414: E( I ) = A( I+1, I )
! 415: E( I+1 ) = ZERO
! 416: A( I+1, I ) = ZERO
! 417: I = I + 1
! 418: ELSE
! 419: E( I ) = ZERO
! 420: END IF
! 421: I = I + 1
! 422: END DO
! 423: *
! 424: * Convert PERMUTATIONS
! 425: *
! 426: * Apply permutaions to submatrices of lower part of A
! 427: * in factorization order where i increases from 1 to N
! 428: *
! 429: I = 1
! 430: DO WHILE ( I.LE.N )
! 431: IF( IPIV( I ).GT.0 ) THEN
! 432: *
! 433: * 1-by-1 pivot interchange
! 434: *
! 435: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
! 436: *
! 437: IP = IPIV( I )
! 438: IF ( I.GT.1 ) THEN
! 439: IF( IP.NE.I ) THEN
! 440: CALL DSWAP( I-1, A( I, 1 ), LDA,
! 441: $ A( IP, 1 ), LDA )
! 442: END IF
! 443: END IF
! 444: *
! 445: ELSE
! 446: *
! 447: * 2-by-2 pivot interchange
! 448: *
! 449: * Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
! 450: * in A(i:N,1:i-1)
! 451: *
! 452: IP = -IPIV( I )
! 453: IP2 = -IPIV( I+1 )
! 454: IF ( I.GT.1 ) THEN
! 455: IF( IP.NE.I ) THEN
! 456: CALL DSWAP( I-1, A( I, 1 ), LDA,
! 457: $ A( IP, 1 ), LDA )
! 458: END IF
! 459: IF( IP2.NE.(I+1) ) THEN
! 460: CALL DSWAP( I-1, A( I+1, 1 ), LDA,
! 461: $ A( IP2, 1 ), LDA )
! 462: END IF
! 463: END IF
! 464: I = I + 1
! 465: *
! 466: END IF
! 467: I = I + 1
! 468: END DO
! 469: *
! 470: ELSE
! 471: *
! 472: * Revert A (A is lower)
! 473: *
! 474: *
! 475: * Revert PERMUTATIONS
! 476: *
! 477: * Apply permutaions to submatrices of lower part of A
! 478: * in reverse factorization order where i decreases from N to 1
! 479: *
! 480: I = N
! 481: DO WHILE ( I.GE.1 )
! 482: IF( IPIV( I ).GT.0 ) THEN
! 483: *
! 484: * 1-by-1 pivot interchange
! 485: *
! 486: * Swap rows i and IPIV(i) in A(i:N,1:i-1)
! 487: *
! 488: IP = IPIV( I )
! 489: IF ( I.GT.1 ) THEN
! 490: IF( IP.NE.I ) THEN
! 491: CALL DSWAP( I-1, A( IP, 1 ), LDA,
! 492: $ A( I, 1 ), LDA )
! 493: END IF
! 494: END IF
! 495: *
! 496: ELSE
! 497: *
! 498: * 2-by-2 pivot interchange
! 499: *
! 500: * Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
! 501: * in A(i:N,1:i-1)
! 502: *
! 503: I = I - 1
! 504: IP = -IPIV( I )
! 505: IP2 = -IPIV( I+1 )
! 506: IF ( I.GT.1 ) THEN
! 507: IF( IP2.NE.(I+1) ) THEN
! 508: CALL DSWAP( I-1, A( IP2, 1 ), LDA,
! 509: $ A( I+1, 1 ), LDA )
! 510: END IF
! 511: IF( IP.NE.I ) THEN
! 512: CALL DSWAP( I-1, A( IP, 1 ), LDA,
! 513: $ A( I, 1 ), LDA )
! 514: END IF
! 515: END IF
! 516: *
! 517: END IF
! 518: I = I - 1
! 519: END DO
! 520: *
! 521: * Revert VALUE
! 522: * Assign subdiagonal entries of D from array E to
! 523: * subgiagonal entries of A.
! 524: *
! 525: I = 1
! 526: DO WHILE ( I.LE.N-1 )
! 527: IF( IPIV( I ).LT.0 ) THEN
! 528: A( I + 1, I ) = E( I )
! 529: I = I + 1
! 530: END IF
! 531: I = I + 1
! 532: END DO
! 533: *
! 534: END IF
! 535: *
! 536: * End A is LOWER
! 537: *
! 538: END IF
! 539:
! 540: RETURN
! 541: *
! 542: * End of DSYCONVF_ROOK
! 543: *
! 544: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dsyconvf_rook.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack