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