LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ssyconv.f
Go to the documentation of this file.
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
 All Files Functions