SRC/dsyswapr.f

   1 *> \brief \b DSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download DSYSWAPR + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyswapr.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyswapr.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyswapr.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER        UPLO
  25 *       INTEGER          I1, I2, LDA, N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       DOUBLE PRECISION A( LDA, N )
  29 *
  30 *
  31 *> \par Purpose:
  32 *  =============
  33 *>
  34 *> \verbatim
  35 *>
  36 *> DSYSWAPR applies an elementary permutation on the rows and the columns of
  37 *> a symmetric matrix.
  38 *> \endverbatim
  39 *
  40 *  Arguments:
  41 *  ==========
  42 *
  43 *> \param[in] UPLO
  44 *> \verbatim
  45 *>          UPLO is CHARACTER*1
  46 *>          Specifies whether the details of the factorization are stored
  47 *>          as an upper or lower triangular matrix.
  48 *>          = 'U':  Upper triangular, form is A = U*D*U**T;
  49 *>          = 'L':  Lower triangular, form is A = L*D*L**T.
  50 *> \endverbatim
  51 *>
  52 *> \param[in] N
  53 *> \verbatim
  54 *>          N is INTEGER
  55 *>          The order of the matrix A.  N >= 0.
  56 *> \endverbatim
  57 *>
  58 *> \param[in,out] A
  59 *> \verbatim
  60 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
  61 *>          On entry, the NB diagonal matrix D and the multipliers
  62 *>          used to obtain the factor U or L as computed by DSYTRF.
  63 *>
  64 *>          On exit, if INFO = 0, the (symmetric) inverse of the original
  65 *>          matrix.  If UPLO = 'U', the upper triangular part of the
  66 *>          inverse is formed and the part of A below the diagonal is not
  67 *>          referenced; if UPLO = 'L' the lower triangular part of the
  68 *>          inverse is formed and the part of A above the diagonal is
  69 *>          not referenced.
  70 *> \endverbatim
  71 *>
  72 *> \param[in] LDA
  73 *> \verbatim
  74 *>          LDA is INTEGER
  75 *>          The leading dimension of the array A.  LDA >= max(1,N).
  76 *> \endverbatim
  77 *>
  78 *> \param[in] I1
  79 *> \verbatim
  80 *>          I1 is INTEGER
  81 *>          Index of the first row to swap
  82 *> \endverbatim
  83 *>
  84 *> \param[in] I2
  85 *> \verbatim
  86 *>          I2 is INTEGER
  87 *>          Index of the second row to swap
  88 *> \endverbatim
  89 *
  90 *  Authors:
  91 *  ========
  92 *
  93 *> \author Univ. of Tennessee
  94 *> \author Univ. of California Berkeley
  95 *> \author Univ. of Colorado Denver
  96 *> \author NAG Ltd.
  97 *
  98 *> \date September 2012
  99 *
 100 *> \ingroup doubleSYauxiliary
 101 *
 102 *  =====================================================================
 103       SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
 104 *
 105 *  -- LAPACK auxiliary routine (version 3.4.2) --
 106 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 107 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 108 *     September 2012
 109 *
 110 *     .. Scalar Arguments ..
 111       CHARACTER        UPLO
 112       INTEGER          I1, I2, LDA, N
 113 *     ..
 114 *     .. Array Arguments ..
 115       DOUBLE PRECISION A( LDA, N )
 116 *
 117 *  =====================================================================
 118 *
 119 *     ..
 120 *     .. Local Scalars ..
 121       LOGICAL            UPPER
 122       INTEGER            I
 123       DOUBLE PRECISION   TMP
 124 *
 125 *     .. External Functions ..
 126       LOGICAL            LSAME
 127       EXTERNAL           LSAME
 128 *     ..
 129 *     .. External Subroutines ..
 130       EXTERNAL         DSWAP
 131 *     ..
 132 *     .. Executable Statements ..
 133 *
 134       UPPER = LSAME( UPLO, 'U' )
 135       IF (UPPER) THEN
 136 *
 137 *         UPPER
 138 *         first swap
 139 *          - swap column I1 and I2 from I1 to I1-1
 140          CALL DSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
 141 *
 142 *          second swap :
 143 *          - swap A(I1,I1) and A(I2,I2)
 144 *          - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1
 145          TMP=A(I1,I1)
 146          A(I1,I1)=A(I2,I2)
 147          A(I2,I2)=TMP
 148 *
 149          DO I=1,I2-I1-1
 150             TMP=A(I1,I1+I)
 151             A(I1,I1+I)=A(I1+I,I2)
 152             A(I1+I,I2)=TMP
 153          END DO
 154 *
 155 *          third swap
 156 *          - swap row I1 and I2 from I2+1 to N
 157          DO I=I2+1,N
 158             TMP=A(I1,I)
 159             A(I1,I)=A(I2,I)
 160             A(I2,I)=TMP
 161          END DO
 162 *
 163         ELSE
 164 *
 165 *         LOWER
 166 *         first swap
 167 *          - swap row I1 and I2 from I1 to I1-1
 168          CALL DSWAP( I1-1, A(I1,1), LDA, A(I2,1), LDA )
 169 *
 170 *         second swap :
 171 *          - swap A(I1,I1) and A(I2,I2)
 172 *          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
 173           TMP=A(I1,I1)
 174           A(I1,I1)=A(I2,I2)
 175           A(I2,I2)=TMP
 176 *
 177           DO I=1,I2-I1-1
 178              TMP=A(I1+I,I1)
 179              A(I1+I,I1)=A(I2,I1+I)
 180              A(I2,I1+I)=TMP
 181           END DO
 182 *
 183 *         third swap
 184 *          - swap col I1 and I2 from I2+1 to N
 185           DO I=I2+1,N
 186              TMP=A(I,I1)
 187              A(I,I1)=A(I,I2)
 188              A(I,I2)=TMP
 189           END DO
 190 *
 191       ENDIF
 192       END SUBROUTINE DSYSWAPR
 193