Annotation of rpl/lapack/lapack/dsyconv.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
! 2: *
! 3: * -- LAPACK PROTOTYPE routine (version 3.3.0) --
! 4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 6: * November 2010
! 7: *
! 8: * -- Written by Julie Langou of the Univ. of TN --
! 9: *
! 10: * .. Scalar Arguments ..
! 11: CHARACTER UPLO, WAY
! 12: INTEGER INFO, LDA, N
! 13: * ..
! 14: * .. Array Arguments ..
! 15: INTEGER IPIV( * )
! 16: DOUBLE PRECISION A( LDA, * ), WORK( * )
! 17: * ..
! 18: *
! 19: * Purpose
! 20: * =======
! 21: *
! 22: * DSYCONV convert A given by TRF into L and D and vice-versa.
! 23: * Get Non-diag elements of D (returned in workspace) and
! 24: * apply or reverse permutation done in TRF.
! 25: *
! 26: * Arguments
! 27: * =========
! 28: *
! 29: * UPLO (input) CHARACTER*1
! 30: * Specifies whether the details of the factorization are stored
! 31: * as an upper or lower triangular matrix.
! 32: * = 'U': Upper triangular, form is A = U*D*U**T;
! 33: * = 'L': Lower triangular, form is A = L*D*L**T.
! 34: *
! 35: * WAY (input) CHARACTER*1
! 36: * = 'C': Convert
! 37: * = 'R': Revert
! 38: *
! 39: * N (input) INTEGER
! 40: * The order of the matrix A. N >= 0.
! 41: *
! 42: * A (input) DOUBLE PRECISION array, dimension (LDA,N)
! 43: * The block diagonal matrix D and the multipliers used to
! 44: * obtain the factor U or L as computed by DSYTRF.
! 45: *
! 46: * LDA (input) INTEGER
! 47: * The leading dimension of the array A. LDA >= max(1,N).
! 48: *
! 49: * IPIV (input) INTEGER array, dimension (N)
! 50: * Details of the interchanges and the block structure of D
! 51: * as determined by DSYTRF.
! 52: *
! 53: * WORK (workspace) DOUBLE PRECISION array, dimension (N)
! 54: *
! 55: * LWORK (input) INTEGER
! 56: * The length of WORK. LWORK >=1.
! 57: * LWORK = N
! 58: *
! 59: * If LWORK = -1, then a workspace query is assumed; the routine
! 60: * only calculates the optimal size of the WORK array, returns
! 61: * this value as the first entry of the WORK array, and no error
! 62: * message related to LWORK is issued by XERBLA.
! 63: *
! 64: * INFO (output) INTEGER
! 65: * = 0: successful exit
! 66: * < 0: if INFO = -i, the i-th argument had an illegal value
! 67: *
! 68: * =====================================================================
! 69: *
! 70: * .. Parameters ..
! 71: DOUBLE PRECISION ZERO
! 72: PARAMETER ( ZERO = 0.0D+0 )
! 73: * ..
! 74: * .. External Functions ..
! 75: LOGICAL LSAME
! 76: EXTERNAL LSAME
! 77: *
! 78: * .. External Subroutines ..
! 79: EXTERNAL XERBLA
! 80: * .. Local Scalars ..
! 81: LOGICAL UPPER, CONVERT
! 82: INTEGER I, IP, J
! 83: DOUBLE PRECISION TEMP
! 84: * ..
! 85: * .. Executable Statements ..
! 86: *
! 87: INFO = 0
! 88: UPPER = LSAME( UPLO, 'U' )
! 89: CONVERT = LSAME( WAY, 'C' )
! 90: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
! 91: INFO = -1
! 92: ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
! 93: INFO = -2
! 94: ELSE IF( N.LT.0 ) THEN
! 95: INFO = -3
! 96: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
! 97: INFO = -5
! 98:
! 99: END IF
! 100: IF( INFO.NE.0 ) THEN
! 101: CALL XERBLA( 'DSYCONV', -INFO )
! 102: RETURN
! 103: END IF
! 104: *
! 105: * Quick return if possible
! 106: *
! 107: IF( N.EQ.0 )
! 108: $ RETURN
! 109: *
! 110: IF( UPPER ) THEN
! 111: *
! 112: * A is UPPER
! 113: *
! 114: * Convert A (A is upper)
! 115: *
! 116: * Convert VALUE
! 117: *
! 118: IF ( CONVERT ) THEN
! 119: I=N
! 120: WORK(1)=ZERO
! 121: DO WHILE ( I .GT. 1 )
! 122: IF( IPIV(I) .LT. 0 ) THEN
! 123: WORK(I)=A(I-1,I)
! 124: A(I-1,I)=ZERO
! 125: I=I-1
! 126: ELSE
! 127: WORK(I)=ZERO
! 128: ENDIF
! 129: I=I-1
! 130: END DO
! 131: *
! 132: * Convert PERMUTATIONS
! 133: *
! 134: I=N
! 135: DO WHILE ( I .GE. 1 )
! 136: IF( IPIV(I) .GT. 0) THEN
! 137: IP=IPIV(I)
! 138: IF( I .LT. N) THEN
! 139: DO 12 J= I+1,N
! 140: TEMP=A(IP,J)
! 141: A(IP,J)=A(I,J)
! 142: A(I,J)=TEMP
! 143: 12 CONTINUE
! 144: ENDIF
! 145: ELSE
! 146: IP=-IPIV(I)
! 147: IF( I .LT. N) THEN
! 148: DO 13 J= I+1,N
! 149: TEMP=A(IP,J)
! 150: A(IP,J)=A(I-1,J)
! 151: A(I-1,J)=TEMP
! 152: 13 CONTINUE
! 153: ENDIF
! 154: I=I-1
! 155: ENDIF
! 156: I=I-1
! 157: END DO
! 158:
! 159: ELSE
! 160: *
! 161: * Revert A (A is upper)
! 162: *
! 163: *
! 164: * Revert PERMUTATIONS
! 165: *
! 166: I=1
! 167: DO WHILE ( I .LE. N )
! 168: IF( IPIV(I) .GT. 0 ) THEN
! 169: IP=IPIV(I)
! 170: IF( I .LT. N) THEN
! 171: DO J= I+1,N
! 172: TEMP=A(IP,J)
! 173: A(IP,J)=A(I,J)
! 174: A(I,J)=TEMP
! 175: END DO
! 176: ENDIF
! 177: ELSE
! 178: IP=-IPIV(I)
! 179: I=I+1
! 180: IF( I .LT. N) THEN
! 181: DO J= I+1,N
! 182: TEMP=A(IP,J)
! 183: A(IP,J)=A(I-1,J)
! 184: A(I-1,J)=TEMP
! 185: END DO
! 186: ENDIF
! 187: ENDIF
! 188: I=I+1
! 189: END DO
! 190: *
! 191: * Revert VALUE
! 192: *
! 193: I=N
! 194: DO WHILE ( I .GT. 1 )
! 195: IF( IPIV(I) .LT. 0 ) THEN
! 196: A(I-1,I)=WORK(I)
! 197: I=I-1
! 198: ENDIF
! 199: I=I-1
! 200: END DO
! 201: END IF
! 202: ELSE
! 203: *
! 204: * A is LOWER
! 205: *
! 206: IF ( CONVERT ) THEN
! 207: *
! 208: * Convert A (A is lower)
! 209: *
! 210: *
! 211: * Convert VALUE
! 212: *
! 213: I=1
! 214: WORK(N)=ZERO
! 215: DO WHILE ( I .LE. N )
! 216: IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
! 217: WORK(I)=A(I+1,I)
! 218: A(I+1,I)=ZERO
! 219: I=I+1
! 220: ELSE
! 221: WORK(I)=ZERO
! 222: ENDIF
! 223: I=I+1
! 224: END DO
! 225: *
! 226: * Convert PERMUTATIONS
! 227: *
! 228: I=1
! 229: DO WHILE ( I .LE. N )
! 230: IF( IPIV(I) .GT. 0 ) THEN
! 231: IP=IPIV(I)
! 232: IF (I .GT. 1) THEN
! 233: DO 22 J= 1,I-1
! 234: TEMP=A(IP,J)
! 235: A(IP,J)=A(I,J)
! 236: A(I,J)=TEMP
! 237: 22 CONTINUE
! 238: ENDIF
! 239: ELSE
! 240: IP=-IPIV(I)
! 241: IF (I .GT. 1) THEN
! 242: DO 23 J= 1,I-1
! 243: TEMP=A(IP,J)
! 244: A(IP,J)=A(I+1,J)
! 245: A(I+1,J)=TEMP
! 246: 23 CONTINUE
! 247: ENDIF
! 248: I=I+1
! 249: ENDIF
! 250: I=I+1
! 251: END DO
! 252: ELSE
! 253: *
! 254: * Revert A (A is lower)
! 255: *
! 256: *
! 257: * Revert PERMUTATIONS
! 258: *
! 259: I=N
! 260: DO WHILE ( I .GE. 1 )
! 261: IF( IPIV(I) .GT. 0 ) THEN
! 262: IP=IPIV(I)
! 263: IF (I .GT. 1) THEN
! 264: DO J= 1,I-1
! 265: TEMP=A(I,J)
! 266: A(I,J)=A(IP,J)
! 267: A(IP,J)=TEMP
! 268: END DO
! 269: ENDIF
! 270: ELSE
! 271: IP=-IPIV(I)
! 272: I=I-1
! 273: IF (I .GT. 1) THEN
! 274: DO J= 1,I-1
! 275: TEMP=A(I+1,J)
! 276: A(I+1,J)=A(IP,J)
! 277: A(IP,J)=TEMP
! 278: END DO
! 279: ENDIF
! 280: ENDIF
! 281: I=I-1
! 282: END DO
! 283: *
! 284: * Revert VALUE
! 285: *
! 286: I=1
! 287: DO WHILE ( I .LE. N-1 )
! 288: IF( IPIV(I) .LT. ZERO ) THEN
! 289: A(I+1,I)=WORK(I)
! 290: I=I+1
! 291: ENDIF
! 292: I=I+1
! 293: END DO
! 294: END IF
! 295: END IF
! 296:
! 297: RETURN
! 298: *
! 299: * End of DSYCONV
! 300: *
! 301: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dsyconv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack