![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SSYCONV 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SSYCONV + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyconv.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyconv.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyconv.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER UPLO, WAY 00025 * INTEGER INFO, LDA, N 00026 * .. 00027 * .. Array Arguments .. 00028 * INTEGER IPIV( * ) 00029 * REAL A( LDA, * ), WORK( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> SSYCONV convert A given by TRF into L and D and vice-versa. 00039 *> Get Non-diag elements of D (returned in workspace) and 00040 *> apply or reverse permutation done in TRF. 00041 *> \endverbatim 00042 * 00043 * Arguments: 00044 * ========== 00045 * 00046 *> \param[in] UPLO 00047 *> \verbatim 00048 *> UPLO is CHARACTER*1 00049 *> Specifies whether the details of the factorization are stored 00050 *> as an upper or lower triangular matrix. 00051 *> = 'U': Upper triangular, form is A = U*D*U**T; 00052 *> = 'L': Lower triangular, form is A = L*D*L**T. 00053 *> \endverbatim 00054 *> 00055 *> \param[in] WAY 00056 *> \verbatim 00057 *> WAY is CHARACTER*1 00058 *> = 'C': Convert 00059 *> = 'R': Revert 00060 *> \endverbatim 00061 *> 00062 *> \param[in] N 00063 *> \verbatim 00064 *> N is INTEGER 00065 *> The order of the matrix A. N >= 0. 00066 *> \endverbatim 00067 *> 00068 *> \param[in] A 00069 *> \verbatim 00070 *> A is REAL array, dimension (LDA,N) 00071 *> The block diagonal matrix D and the multipliers used to 00072 *> obtain the factor U or L as computed by SSYTRF. 00073 *> \endverbatim 00074 *> 00075 *> \param[in] LDA 00076 *> \verbatim 00077 *> LDA is INTEGER 00078 *> The leading dimension of the array A. LDA >= max(1,N). 00079 *> \endverbatim 00080 *> 00081 *> \param[in] IPIV 00082 *> \verbatim 00083 *> IPIV is INTEGER array, dimension (N) 00084 *> Details of the interchanges and the block structure of D 00085 *> as determined by SSYTRF. 00086 *> \endverbatim 00087 *> 00088 *> \param[out] WORK 00089 *> \verbatim 00090 *> WORK is REAL array, dimension (N) 00091 *> \endverbatim 00092 *> 00093 *> \param[out] INFO 00094 *> \verbatim 00095 *> INFO is INTEGER 00096 *> = 0: successful exit 00097 *> < 0: if INFO = -i, the i-th argument had an illegal value 00098 *> \endverbatim 00099 * 00100 * Authors: 00101 * ======== 00102 * 00103 *> \author Univ. of Tennessee 00104 *> \author Univ. of California Berkeley 00105 *> \author Univ. of Colorado Denver 00106 *> \author NAG Ltd. 00107 * 00108 *> \date November 2011 00109 * 00110 *> \ingroup realSYcomputational 00111 * 00112 * ===================================================================== 00113 SUBROUTINE SSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO ) 00114 * 00115 * -- LAPACK computational routine (version 3.4.0) -- 00116 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00117 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00118 * November 2011 00119 * 00120 * .. Scalar Arguments .. 00121 CHARACTER UPLO, WAY 00122 INTEGER INFO, LDA, N 00123 * .. 00124 * .. Array Arguments .. 00125 INTEGER IPIV( * ) 00126 REAL A( LDA, * ), WORK( * ) 00127 * .. 00128 * 00129 * ===================================================================== 00130 * 00131 * .. Parameters .. 00132 REAL ZERO 00133 PARAMETER ( ZERO = 0.0E+0 ) 00134 * .. 00135 * .. External Functions .. 00136 LOGICAL LSAME 00137 EXTERNAL LSAME 00138 * 00139 * .. External Subroutines .. 00140 EXTERNAL XERBLA 00141 * .. Local Scalars .. 00142 LOGICAL UPPER, CONVERT 00143 INTEGER I, IP, J 00144 REAL TEMP 00145 * .. 00146 * .. Executable Statements .. 00147 * 00148 INFO = 0 00149 UPPER = LSAME( UPLO, 'U' ) 00150 CONVERT = LSAME( WAY, 'C' ) 00151 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00152 INFO = -1 00153 ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN 00154 INFO = -2 00155 ELSE IF( N.LT.0 ) THEN 00156 INFO = -3 00157 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00158 INFO = -5 00159 00160 END IF 00161 IF( INFO.NE.0 ) THEN 00162 CALL XERBLA( 'SSYCONV', -INFO ) 00163 RETURN 00164 END IF 00165 * 00166 * Quick return if possible 00167 * 00168 IF( N.EQ.0 ) 00169 $ RETURN 00170 * 00171 IF( UPPER ) THEN 00172 * 00173 * A is UPPER 00174 * 00175 * Convert A (A is upper) 00176 * 00177 * Convert VALUE 00178 * 00179 IF ( CONVERT ) THEN 00180 I=N 00181 WORK(1)=ZERO 00182 DO WHILE ( I .GT. 1 ) 00183 IF( IPIV(I) .LT. 0 ) THEN 00184 WORK(I)=A(I-1,I) 00185 A(I-1,I)=ZERO 00186 I=I-1 00187 ELSE 00188 WORK(I)=ZERO 00189 ENDIF 00190 I=I-1 00191 END DO 00192 * 00193 * Convert PERMUTATIONS 00194 * 00195 I=N 00196 DO WHILE ( I .GE. 1 ) 00197 IF( IPIV(I) .GT. 0) THEN 00198 IP=IPIV(I) 00199 IF( I .LT. N) THEN 00200 DO 12 J= I+1,N 00201 TEMP=A(IP,J) 00202 A(IP,J)=A(I,J) 00203 A(I,J)=TEMP 00204 12 CONTINUE 00205 ENDIF 00206 ELSE 00207 IP=-IPIV(I) 00208 IF( I .LT. N) THEN 00209 DO 13 J= I+1,N 00210 TEMP=A(IP,J) 00211 A(IP,J)=A(I-1,J) 00212 A(I-1,J)=TEMP 00213 13 CONTINUE 00214 ENDIF 00215 I=I-1 00216 ENDIF 00217 I=I-1 00218 END DO 00219 00220 ELSE 00221 * 00222 * Revert A (A is upper) 00223 * 00224 * 00225 * Revert PERMUTATIONS 00226 * 00227 I=1 00228 DO WHILE ( I .LE. N ) 00229 IF( IPIV(I) .GT. 0 ) THEN 00230 IP=IPIV(I) 00231 IF( I .LT. N) THEN 00232 DO J= I+1,N 00233 TEMP=A(IP,J) 00234 A(IP,J)=A(I,J) 00235 A(I,J)=TEMP 00236 END DO 00237 ENDIF 00238 ELSE 00239 IP=-IPIV(I) 00240 I=I+1 00241 IF( I .LT. N) THEN 00242 DO J= I+1,N 00243 TEMP=A(IP,J) 00244 A(IP,J)=A(I-1,J) 00245 A(I-1,J)=TEMP 00246 END DO 00247 ENDIF 00248 ENDIF 00249 I=I+1 00250 END DO 00251 * 00252 * Revert VALUE 00253 * 00254 I=N 00255 DO WHILE ( I .GT. 1 ) 00256 IF( IPIV(I) .LT. 0 ) THEN 00257 A(I-1,I)=WORK(I) 00258 I=I-1 00259 ENDIF 00260 I=I-1 00261 END DO 00262 END IF 00263 ELSE 00264 * 00265 * A is LOWER 00266 * 00267 IF ( CONVERT ) THEN 00268 * 00269 * Convert A (A is lower) 00270 * 00271 * 00272 * Convert VALUE 00273 * 00274 I=1 00275 WORK(N)=ZERO 00276 DO WHILE ( I .LE. N ) 00277 IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN 00278 WORK(I)=A(I+1,I) 00279 A(I+1,I)=ZERO 00280 I=I+1 00281 ELSE 00282 WORK(I)=ZERO 00283 ENDIF 00284 I=I+1 00285 END DO 00286 * 00287 * Convert PERMUTATIONS 00288 * 00289 I=1 00290 DO WHILE ( I .LE. N ) 00291 IF( IPIV(I) .GT. 0 ) THEN 00292 IP=IPIV(I) 00293 IF (I .GT. 1) THEN 00294 DO 22 J= 1,I-1 00295 TEMP=A(IP,J) 00296 A(IP,J)=A(I,J) 00297 A(I,J)=TEMP 00298 22 CONTINUE 00299 ENDIF 00300 ELSE 00301 IP=-IPIV(I) 00302 IF (I .GT. 1) THEN 00303 DO 23 J= 1,I-1 00304 TEMP=A(IP,J) 00305 A(IP,J)=A(I+1,J) 00306 A(I+1,J)=TEMP 00307 23 CONTINUE 00308 ENDIF 00309 I=I+1 00310 ENDIF 00311 I=I+1 00312 END DO 00313 ELSE 00314 * 00315 * Revert A (A is lower) 00316 * 00317 * 00318 * Revert PERMUTATIONS 00319 * 00320 I=N 00321 DO WHILE ( I .GE. 1 ) 00322 IF( IPIV(I) .GT. 0 ) THEN 00323 IP=IPIV(I) 00324 IF (I .GT. 1) THEN 00325 DO J= 1,I-1 00326 TEMP=A(I,J) 00327 A(I,J)=A(IP,J) 00328 A(IP,J)=TEMP 00329 END DO 00330 ENDIF 00331 ELSE 00332 IP=-IPIV(I) 00333 I=I-1 00334 IF (I .GT. 1) THEN 00335 DO J= 1,I-1 00336 TEMP=A(I+1,J) 00337 A(I+1,J)=A(IP,J) 00338 A(IP,J)=TEMP 00339 END DO 00340 ENDIF 00341 ENDIF 00342 I=I-1 00343 END DO 00344 * 00345 * Revert VALUE 00346 * 00347 I=1 00348 DO WHILE ( I .LE. N-1 ) 00349 IF( IPIV(I) .LT. 0 ) THEN 00350 A(I+1,I)=WORK(I) 00351 I=I+1 00352 ENDIF 00353 I=I+1 00354 END DO 00355 END IF 00356 END IF 00357 00358 RETURN 00359 * 00360 * End of SSYCONV 00361 * 00362 END