Return to zheswapr.f CVS log

Up to [local] / rpl / lapack / lapack

Ajout de zheswapr.f

    1:       SUBROUTINE ZHESWAPR( UPLO, N, A, LDA, I1, I2)
    2: *
    3: *  -- LAPACK auxiliary routine (version 3.3.1) --
    4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    6: *  -- April 2011                                                      --
    7: *
    8: *     .. Scalar Arguments ..
    9:       CHARACTER        UPLO
   10:       INTEGER          I1, I2, LDA, N
   11: *     ..
   12: *     .. Array Arguments ..
   13:       COMPLEX*16          A( LDA, N )
   14: *
   15: *  Purpose
   16: *  =======
   17: *
   18: *  ZHESWAPR applies an elementary permutation on the rows and the columns of
   19: *  a hermitian matrix.
   20: *
   21: *  Arguments
   22: *  =========
   23: *
   24: *  UPLO    (input) CHARACTER*1
   25: *          Specifies whether the details of the factorization are stored
   26: *          as an upper or lower triangular matrix.
   27: *          = 'U':  Upper triangular, form is A = U*D*U**T;
   28: *          = 'L':  Lower triangular, form is A = L*D*L**T.
   29: *
   30: *  N       (input) INTEGER
   31: *          The order of the matrix A.  N >= 0.
   32: *
   33: *  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
   34: *          On entry, the NB diagonal matrix D and the multipliers
   35: *          used to obtain the factor U or L as computed by CSYTRF.
   36: *
   37: *          On exit, if INFO = 0, the (symmetric) inverse of the original
   38: *          matrix.  If UPLO = 'U', the upper triangular part of the
   39: *          inverse is formed and the part of A below the diagonal is not
   40: *          referenced; if UPLO = 'L' the lower triangular part of the
   41: *          inverse is formed and the part of A above the diagonal is
   42: *          not referenced.
   43: *
   44: *  LDA     (input) INTEGER
   45: *          The leading dimension of the array A.  LDA >= max(1,N).
   46: *
   47: *  I1      (input) INTEGER
   48: *          Index of the first row to swap
   49: *
   50: *  I2      (input) INTEGER
   51: *          Index of the second row to swap
   52: *
   53: *  =====================================================================
   54: *
   55: *     ..
   56: *     .. Local Scalars ..
   57:       LOGICAL            UPPER
   58:       INTEGER            I
   59:       COMPLEX*16            TMP
   60: *
   61: *     .. External Functions ..
   62:       LOGICAL            LSAME
   63:       EXTERNAL           LSAME
   64: *     ..
   65: *     .. External Subroutines ..
   66:       EXTERNAL           ZSWAP
   67: *     ..
   68: *     .. Executable Statements ..
   69: *
   70:       UPPER = LSAME( UPLO, 'U' )
   71:       IF (UPPER) THEN
   72: *
   73: *         UPPER
   74: *         first swap
   75: *          - swap column I1 and I2 from I1 to I1-1 
   76:          CALL ZSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
   77: *
   78: *          second swap :
   79: *          - swap A(I1,I1) and A(I2,I2)
   80: *          - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1
   81: *          - swap A(I2,I1) and A(I1,I2)
   82:      
   83:          TMP=A(I1,I1)
   84:          A(I1,I1)=A(I2,I2)
   85:          A(I2,I2)=TMP
   86: *
   87:          DO I=1,I2-I1-1
   88:             TMP=A(I1,I1+I)
   89:             A(I1,I1+I)=DCONJG(A(I1+I,I2))
   90:             A(I1+I,I2)=DCONJG(TMP)
   91:          END DO
   92: *
   93:           A(I1,I2)=DCONJG(A(I1,I2))
   94: 
   95: *
   96: *          third swap
   97: *          - swap row I1 and I2 from I2+1 to N
   98:          DO I=I2+1,N
   99:             TMP=A(I1,I)
  100:             A(I1,I)=A(I2,I)
  101:             A(I2,I)=TMP
  102:          END DO
  103: *
  104:         ELSE
  105: *
  106: *         LOWER
  107: *         first swap
  108: *          - swap row I1 and I2 from 1 to I1-1 
  109:          CALL ZSWAP ( I1-1, A(I1,1), LDA, A(I2,1), LDA )
  110: *
  111: *         second swap :
  112: *          - swap A(I1,I1) and A(I2,I2)
  113: *          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1     
  114: *          - swap A(I2,I1) and A(I1,I2)
  115: 
  116:           TMP=A(I1,I1)
  117:           A(I1,I1)=A(I2,I2)
  118:           A(I2,I2)=TMP
  119: *
  120:           DO I=1,I2-I1-1
  121:              TMP=A(I1+I,I1)
  122:              A(I1+I,I1)=DCONJG(A(I2,I1+I))
  123:              A(I2,I1+I)=DCONJG(TMP)
  124:           END DO
  125: *
  126:           A(I2,I1)=DCONJG(A(I2,I1))
  127: *
  128: *         third swap
  129: *          - swap col I1 and I2 from I2+1 to N
  130:           DO I=I2+1,N
  131:              TMP=A(I,I1)
  132:              A(I,I1)=A(I,I2)
  133:              A(I,I2)=TMP
  134:           END DO
  135: *
  136:       ENDIF
  137:       
  138:       END SUBROUTINE ZHESWAPR
  139: