File:  [local] / rpl / lapack / lapack / dsyswapr.f
Revision 1.1: download - view: text, annotated - select for diffs - revision graph
Tue Dec 21 13:50:37 2010 UTC (13 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Mise à jour de Lapack vers la version 3.3.0.

    1:       SUBROUTINE DSYSWAPR( UPLO, N, A, I1, I2)
    2: *
    3: *  -- LAPACK auxiliary routine (version 3.3.0) --
    4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    6: *     November 2010
    7: *
    8: *     .. Scalar Arguments ..
    9:       CHARACTER        UPLO
   10:       INTEGER          I1, I2, N
   11: *     ..
   12: *     .. Array Arguments ..
   13:       DOUBLE PRECISION A(N,N)
   14: *
   15: *  Purpose
   16: *  =======
   17: *
   18: *  DSYSWAPR applies an elementary permutation on the rows and the columns of
   19: *  a symmetric 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) DOUBLE PRECISION 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 DSYTRF.
   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: *  I1      (input) INTEGER
   45: *          Index of the first row to swap
   46: *
   47: *  I2      (input) INTEGER
   48: *          Index of the second row to swap
   49: *
   50: *  =====================================================================
   51: *
   52: *     ..
   53: *     .. Local Scalars ..
   54:       LOGICAL            UPPER
   55:       INTEGER            I
   56:       DOUBLE PRECISION   TMP
   57: *
   58: *     .. External Functions ..
   59:       LOGICAL            LSAME
   60:       EXTERNAL           LSAME
   61: *     ..
   62: *     .. External Subroutines ..
   63:       EXTERNAL         DSWAP
   64: *     ..
   65: *     .. Executable Statements ..
   66: *
   67:       UPPER = LSAME( UPLO, 'U' )
   68:       IF (UPPER) THEN
   69: *
   70: *         UPPER
   71: *         first swap
   72: *          - swap column I1 and I2 from I1 to I1-1 
   73:          CALL DSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
   74: *
   75: *          second swap :
   76: *          - swap A(I1,I1) and A(I2,I2)
   77: *          - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1     
   78:          TMP=A(I1,I1)
   79:          A(I1,I1)=A(I2,I2)
   80:          A(I2,I2)=TMP
   81: *
   82:          DO I=1,I2-I1-1
   83:             TMP=A(I1,I1+I)
   84:             A(I1,I1+I)=A(I1+I,I2)
   85:             A(I1+I,I2)=TMP
   86:          END DO
   87: *
   88: *          third swap
   89: *          - swap row I1 and I2 from I2+1 to N
   90:          DO I=I2+1,N
   91:             TMP=A(I1,I)
   92:             A(I1,I)=A(I2,I)
   93:             A(I2,I)=TMP
   94:          END DO
   95: *
   96:         ELSE
   97: *
   98: *         LOWER
   99: *         first swap
  100: *          - swap row I1 and I2 from I1 to I1-1 
  101:          CALL DSWAP( I1-1, A(I1,1), N, A(I2,1), N )
  102: *
  103: *         second swap :
  104: *          - swap A(I1,I1) and A(I2,I2)
  105: *          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1     
  106:           TMP=A(I1,I1)
  107:           A(I1,I1)=A(I2,I2)
  108:           A(I2,I2)=TMP
  109: *
  110:           DO I=1,I2-I1-1
  111:              TMP=A(I1+I,I1)
  112:              A(I1+I,I1)=A(I2,I1+I)
  113:              A(I2,I1+I)=TMP
  114:           END DO
  115: *
  116: *         third swap
  117: *          - swap col I1 and I2 from I2+1 to N
  118:           DO I=I2+1,N
  119:              TMP=A(I,I1)
  120:              A(I,I1)=A(I,I2)
  121:              A(I,I2)=TMP
  122:           END DO
  123: *
  124:       ENDIF
  125:       END SUBROUTINE DSYSWAPR
  126: 

CVSweb interface <joel.bertrand@systella.fr>