 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE CSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO ) 00002 * 00003 * -- LAPACK PROTOTYPE routine (version 3.2.2) -- 00004 * 00005 * -- Written by Julie Langou of the Univ. of TN -- 00006 * May 2010 00007 * 00008 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00009 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00010 * 00011 * .. Scalar Arguments .. 00012 CHARACTER UPLO, WAY 00013 INTEGER INFO, LDA, N 00014 * .. 00015 * .. Array Arguments .. 00016 INTEGER IPIV( * ) 00017 COMPLEX A( LDA, * ), WORK( * ) 00018 * .. 00019 * 00020 * Purpose 00021 * ======= 00022 * 00023 * CSYCONV convert A given by TRF into L and D and vice-versa. 00024 * Get Non-diag elements of D (returned in workspace) and 00025 * apply or reverse permutation done in TRF. 00026 * 00027 * Arguments 00028 * ========= 00029 * 00030 * UPLO (input) CHARACTER*1 00031 * Specifies whether the details of the factorization are stored 00032 * as an upper or lower triangular matrix. 00033 * = 'U': Upper triangular, form is A = U*D*U**T; 00034 * = 'L': Lower triangular, form is A = L*D*L**T. 00035 * 00036 * WAY (input) CHARACTER*1 00037 * = 'C': Convert 00038 * = 'R': Revert 00039 * 00040 * N (input) INTEGER 00041 * The order of the matrix A. N >= 0. 00042 * 00043 * A (input) COMPLEX array, dimension (LDA,N) 00044 * The block diagonal matrix D and the multipliers used to 00045 * obtain the factor U or L as computed by CSYTRF. 00046 * 00047 * LDA (input) INTEGER 00048 * The leading dimension of the array A. LDA >= max(1,N). 00049 * 00050 * IPIV (input) INTEGER array, dimension (N) 00051 * Details of the interchanges and the block structure of D 00052 * as determined by CSYTRF. 00053 * 00054 * WORK (workspace) COMPLEX array, dimension (N) 00055 * 00056 * LWORK (input) INTEGER 00057 * The length of WORK. LWORK >=1. 00058 * LWORK = N 00059 * 00060 * If LWORK = -1, then a workspace query is assumed; the routine 00061 * only calculates the optimal size of the WORK array, returns 00062 * this value as the first entry of the WORK array, and no error 00063 * message related to LWORK is issued by XERBLA. 00064 * 00065 * INFO (output) INTEGER 00066 * = 0: successful exit 00067 * < 0: if INFO = -i, the i-th argument had an illegal value 00068 * 00069 * ===================================================================== 00070 * 00071 * .. Parameters .. 00072 COMPLEX ZERO 00073 PARAMETER ( ZERO = (0.0E+0,0.0E+0) ) 00074 * .. 00075 * .. External Functions .. 00076 LOGICAL LSAME 00077 EXTERNAL LSAME 00078 * 00079 * .. External Subroutines .. 00080 EXTERNAL XERBLA 00081 * .. Local Scalars .. 00082 LOGICAL UPPER, CONVERT 00083 INTEGER I, IP, J 00084 COMPLEX TEMP 00085 * .. 00086 * .. Executable Statements .. 00087 * 00088 INFO = 0 00089 UPPER = LSAME( UPLO, 'U' ) 00090 CONVERT = LSAME( WAY, 'C' ) 00091 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00092 INFO = -1 00093 ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN 00094 INFO = -2 00095 ELSE IF( N.LT.0 ) THEN 00096 INFO = -3 00097 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00098 INFO = -5 00099 00100 END IF 00101 IF( INFO.NE.0 ) THEN 00102 CALL XERBLA( 'CSYCONV', -INFO ) 00103 RETURN 00104 END IF 00105 * 00106 * Quick return if possible 00107 * 00108 IF( N.EQ.0 ) 00109 $ RETURN 00110 * 00111 IF( UPPER ) THEN 00112 * 00113 * A is UPPER 00114 * 00115 * Convert A (A is upper) 00116 * 00117 * Convert VALUE 00118 * 00119 IF ( CONVERT ) THEN 00120 I=N 00121 WORK(1)=ZERO 00122 DO WHILE ( I .GT. 1 ) 00123 IF( IPIV(I) .LT. 0 ) THEN 00124 WORK(I)=A(I-1,I) 00125 A(I-1,I)=ZERO 00126 I=I-1 00127 ELSE 00128 WORK(I)=ZERO 00129 ENDIF 00130 I=I-1 00131 END DO 00132 * 00133 * Convert PERMUTATIONS 00134 * 00135 I=N 00136 DO WHILE ( I .GE. 1 ) 00137 IF( IPIV(I) .GT. 0) THEN 00138 IP=IPIV(I) 00139 IF( I .LT. N) THEN 00140 DO 12 J= I+1,N 00141 TEMP=A(IP,J) 00142 A(IP,J)=A(I,J) 00143 A(I,J)=TEMP 00144 12 CONTINUE 00145 ENDIF 00146 ELSE 00147 IP=-IPIV(I) 00148 IF( I .LT. N) THEN 00149 DO 13 J= I+1,N 00150 TEMP=A(IP,J) 00151 A(IP,J)=A(I-1,J) 00152 A(I-1,J)=TEMP 00153 13 CONTINUE 00154 ENDIF 00155 I=I-1 00156 ENDIF 00157 I=I-1 00158 END DO 00159 00160 ELSE 00161 * 00162 * Revert A (A is upper) 00163 * 00164 * 00165 * Revert PERMUTATIONS 00166 * 00167 I=1 00168 DO WHILE ( I .LE. N ) 00169 IF( IPIV(I) .GT. 0 ) THEN 00170 IP=IPIV(I) 00171 IF( I .LT. N) THEN 00172 DO J= I+1,N 00173 TEMP=A(IP,J) 00174 A(IP,J)=A(I,J) 00175 A(I,J)=TEMP 00176 END DO 00177 ENDIF 00178 ELSE 00179 IP=-IPIV(I) 00180 I=I+1 00181 IF( I .LT. N) THEN 00182 DO J= I+1,N 00183 TEMP=A(IP,J) 00184 A(IP,J)=A(I-1,J) 00185 A(I-1,J)=TEMP 00186 END DO 00187 ENDIF 00188 ENDIF 00189 I=I+1 00190 END DO 00191 * 00192 * Revert VALUE 00193 * 00194 I=N 00195 DO WHILE ( I .GT. 1 ) 00196 IF( IPIV(I) .LT. 0 ) THEN 00197 A(I-1,I)=WORK(I) 00198 I=I-1 00199 ENDIF 00200 I=I-1 00201 END DO 00202 END IF 00203 ELSE 00204 * 00205 * A is LOWER 00206 * 00207 IF ( CONVERT ) THEN 00208 * 00209 * Convert A (A is lower) 00210 * 00211 * 00212 * Convert VALUE 00213 * 00214 I=1 00215 WORK(N)=ZERO 00216 DO WHILE ( I .LE. N ) 00217 IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN 00218 WORK(I)=A(I+1,I) 00219 A(I+1,I)=ZERO 00220 I=I+1 00221 ELSE 00222 WORK(I)=ZERO 00223 ENDIF 00224 I=I+1 00225 END DO 00226 * 00227 * Convert PERMUTATIONS 00228 * 00229 I=1 00230 DO WHILE ( I .LE. N ) 00231 IF( IPIV(I) .GT. 0 ) THEN 00232 IP=IPIV(I) 00233 IF (I .GT. 1) THEN 00234 DO 22 J= 1,I-1 00235 TEMP=A(IP,J) 00236 A(IP,J)=A(I,J) 00237 A(I,J)=TEMP 00238 22 CONTINUE 00239 ENDIF 00240 ELSE 00241 IP=-IPIV(I) 00242 IF ( I .GT. 1 ) THEN 00243 DO 23 J= 1,I-1 00244 TEMP=A(IP,J) 00245 A(IP,J)=A(I+1,J) 00246 A(I+1,J)=TEMP 00247 23 CONTINUE 00248 ENDIF 00249 I=I+1 00250 ENDIF 00251 I=I+1 00252 END DO 00253 ELSE 00254 * 00255 * Revert A (A is lower) 00256 * 00257 * 00258 * Revert PERMUTATIONS 00259 * 00260 I=N 00261 DO WHILE ( I .GE. 1 ) 00262 IF( IPIV(I) .GT. 0 ) THEN 00263 IP=IPIV(I) 00264 IF (I .GT. 1) THEN 00265 DO J= 1,I-1 00266 TEMP=A(I,J) 00267 A(I,J)=A(IP,J) 00268 A(IP,J)=TEMP 00269 END DO 00270 ENDIF 00271 ELSE 00272 IP=-IPIV(I) 00273 I=I-1 00274 IF (I .GT. 1) THEN 00275 DO J= 1,I-1 00276 TEMP=A(I+1,J) 00277 A(I+1,J)=A(IP,J) 00278 A(IP,J)=TEMP 00279 END DO 00280 ENDIF 00281 ENDIF 00282 I=I-1 00283 END DO 00284 * 00285 * Revert VALUE 00286 * 00287 I=1 00288 DO WHILE ( I .LE. N-1 ) 00289 IF( IPIV(I) .LT. 0 ) THEN 00290 A(I+1,I)=WORK(I) 00291 I=I+1 00292 ENDIF 00293 I=I+1 00294 END DO 00295 END IF 00296 END IF 00297 00298 RETURN 00299 * 00300 * End of CSYCONV 00301 * 00302 END
1.7.3 
