SRC/zheswapr.f

   1 *> \brief \b ZHESWAPR applies an elementary permutation on the rows and columns of a Hermitian matrix.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZHESWAPR + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheswapr.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheswapr.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheswapr.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE ZHESWAPR( UPLO, N, A, LDA, I1, I2)
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER        UPLO
  25 *       INTEGER          I1, I2, LDA, N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       COMPLEX*16          A( LDA, N )
  29 *
  30 *
  31 *> \par Purpose:
  32 *  =============
  33 *>
  34 *> \verbatim
  35 *>
  36 *> ZHESWAPR applies an elementary permutation on the rows and the columns of
  37 *> a hermitian 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 COMPLEX*16 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 CSYTRF.
  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 complex16HEauxiliary
 101 *
 102 *  =====================================================================
 103       SUBROUTINE ZHESWAPR( 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       COMPLEX*16          A( LDA, N )
 116 *
 117 *  =====================================================================
 118 *
 119 *     ..
 120 *     .. Local Scalars ..
 121       LOGICAL            UPPER
 122       INTEGER            I
 123       COMPLEX*16            TMP
 124 *
 125 *     .. External Functions ..
 126       LOGICAL            LSAME
 127       EXTERNAL           LSAME
 128 *     ..
 129 *     .. External Subroutines ..
 130       EXTERNAL           ZSWAP
 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 ZSWAP( 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 *          - swap A(I2,I1) and A(I1,I2)
 146
 147          TMP=A(I1,I1)
 148          A(I1,I1)=A(I2,I2)
 149          A(I2,I2)=TMP
 150 *
 151          DO I=1,I2-I1-1
 152             TMP=A(I1,I1+I)
 153             A(I1,I1+I)=DCONJG(A(I1+I,I2))
 154             A(I1+I,I2)=DCONJG(TMP)
 155          END DO
 156 *
 157           A(I1,I2)=DCONJG(A(I1,I2))
 158
 159 *
 160 *          third swap
 161 *          - swap row I1 and I2 from I2+1 to N
 162          DO I=I2+1,N
 163             TMP=A(I1,I)
 164             A(I1,I)=A(I2,I)
 165             A(I2,I)=TMP
 166          END DO
 167 *
 168         ELSE
 169 *
 170 *         LOWER
 171 *         first swap
 172 *          - swap row I1 and I2 from 1 to I1-1
 173          CALL ZSWAP ( I1-1, A(I1,1), LDA, A(I2,1), LDA )
 174 *
 175 *         second swap :
 176 *          - swap A(I1,I1) and A(I2,I2)
 177 *          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
 178 *          - swap A(I2,I1) and A(I1,I2)
 179
 180           TMP=A(I1,I1)
 181           A(I1,I1)=A(I2,I2)
 182           A(I2,I2)=TMP
 183 *
 184           DO I=1,I2-I1-1
 185              TMP=A(I1+I,I1)
 186              A(I1+I,I1)=DCONJG(A(I2,I1+I))
 187              A(I2,I1+I)=DCONJG(TMP)
 188           END DO
 189 *
 190           A(I2,I1)=DCONJG(A(I2,I1))
 191 *
 192 *         third swap
 193 *          - swap col I1 and I2 from I2+1 to N
 194           DO I=I2+1,N
 195              TMP=A(I,I1)
 196              A(I,I1)=A(I,I2)
 197              A(I,I2)=TMP
 198           END DO
 199 *
 200       ENDIF
 201
 202       END SUBROUTINE ZHESWAPR
 203