![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
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