LAPACK: SRC/csyconv.f Source File

Go to the documentation of this file.
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