LAPACK: SRC/zsyconv.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZSYCONV( 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       DOUBLE COMPLEX     A( LDA, * ), WORK( * )
00018 *     ..
00019 *
00020 *  Purpose
00021 *  =======
00022 *
00023 *  ZSYCONV converts A given by ZHETRF into L and D or vice-versa.
00024 *  Get nondiagonal 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) DOUBLE 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 ZSYTRF.
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 ZSYTRF.
00053 *
00054 * WORK     (workspace) DOUBLE 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       DOUBLE COMPLEX     ZERO
00073       PARAMETER          ( ZERO = (0.0D+0,0.0D+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       DOUBLE 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( 'ZSYCONV', -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          IF ( CONVERT ) THEN
00116 *
00117 *           Convert A (A is upper)
00118 *
00119 *           Convert VALUE
00120 *
00121             I=N
00122             WORK(1)=ZERO
00123             DO WHILE ( I .GT. 1 )
00124                IF( IPIV(I) .LT. 0 ) THEN
00125                   WORK(I)=A(I-1,I)
00126                   A(I-1,I)=ZERO
00127                   I=I-1
00128                ELSE
00129                   WORK(I)=ZERO
00130                ENDIF
00131                I=I-1
00132             END DO
00133 *
00134 *           Convert PERMUTATIONS
00135 *  
00136             I=N
00137             DO WHILE ( I .GE. 1 )
00138                IF( IPIV(I) .GT. 0) THEN
00139                   IP=IPIV(I)
00140                   IF( I .LT. N) THEN
00141                      DO 12 J= I+1,N
00142                        TEMP=A(IP,J)
00143                        A(IP,J)=A(I,J)
00144                        A(I,J)=TEMP
00145  12                  CONTINUE
00146                   ENDIF
00147                ELSE
00148                   IP=-IPIV(I)
00149                   IF( I .LT. N) THEN
00150                      DO 13 J= I+1,N
00151                         TEMP=A(IP,J)
00152                         A(IP,J)=A(I-1,J)
00153                         A(I-1,J)=TEMP
00154  13                  CONTINUE
00155                   ENDIF
00156                   I=I-1
00157                ENDIF
00158                I=I-1
00159             END DO
00160 *
00161          ELSE
00162 *
00163 *           Revert A (A is upper)
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 *
00204       ELSE
00205 *
00206 *        A is LOWER
00207 *
00208          IF ( CONVERT ) THEN
00209 *
00210 *           Convert A (A is lower)
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 *
00254          ELSE
00255 *
00256 *           Revert A (A is lower)
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 ZSYCONV
00301 *
00302       END