File:  [local] / rpl / lapack / lapack / zsyswapr.f
Revision 1.13: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:38 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief \b ZSYSWAPR
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZSYSWAPR + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyswapr.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyswapr.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyswapr.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZSYSWAPR( 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: *> ZSYSWAPR 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 COMPLEX*16 array, dimension (LDA,*)
   61: *>          On entry, the N-by-N matrix A. On exit, the permuted matrix
   62: *>          where the rows I1 and I2 and columns I1 and I2 are interchanged.
   63: *>          If UPLO = 'U', the interchanges are applied to the upper
   64: *>          triangular part and the strictly lower triangular part of A is
   65: *>          not referenced; if UPLO = 'L', the interchanges are applied to
   66: *>          the lower triangular part and the part of A above the diagonal
   67: *>          is not referenced.
   68: *> \endverbatim
   69: *>
   70: *> \param[in] LDA
   71: *> \verbatim
   72: *>          LDA is INTEGER
   73: *>          The leading dimension of the array A.  LDA >= max(1,N).
   74: *> \endverbatim
   75: *>
   76: *> \param[in] I1
   77: *> \verbatim
   78: *>          I1 is INTEGER
   79: *>          Index of the first row to swap
   80: *> \endverbatim
   81: *>
   82: *> \param[in] I2
   83: *> \verbatim
   84: *>          I2 is INTEGER
   85: *>          Index of the second row to swap
   86: *> \endverbatim
   87: *
   88: *  Authors:
   89: *  ========
   90: *
   91: *> \author Univ. of Tennessee
   92: *> \author Univ. of California Berkeley
   93: *> \author Univ. of Colorado Denver
   94: *> \author NAG Ltd.
   95: *
   96: *> \ingroup complex16SYauxiliary
   97: *
   98: *  =====================================================================
   99:       SUBROUTINE ZSYSWAPR( UPLO, N, A, LDA, I1, I2)
  100: *
  101: *  -- LAPACK auxiliary routine --
  102: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  103: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  104: *
  105: *     .. Scalar Arguments ..
  106:       CHARACTER        UPLO
  107:       INTEGER          I1, I2, LDA, N
  108: *     ..
  109: *     .. Array Arguments ..
  110:       COMPLEX*16       A( LDA, * )
  111: *
  112: *  =====================================================================
  113: *
  114: *     ..
  115: *     .. Local Scalars ..
  116:       LOGICAL            UPPER
  117:       COMPLEX*16         TMP
  118: *
  119: *     .. External Functions ..
  120:       LOGICAL            LSAME
  121:       EXTERNAL           LSAME
  122: *     ..
  123: *     .. External Subroutines ..
  124:       EXTERNAL           ZSWAP
  125: *     ..
  126: *     .. Executable Statements ..
  127: *
  128:       UPPER = LSAME( UPLO, 'U' )
  129:       IF (UPPER) THEN
  130: *
  131: *         UPPER
  132: *         first swap
  133: *          - swap column I1 and I2 from I1 to I1-1
  134:          CALL ZSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
  135: *
  136: *          second swap :
  137: *          - swap A(I1,I1) and A(I2,I2)
  138: *          - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1
  139:          TMP=A(I1,I1)
  140:          A(I1,I1)=A(I2,I2)
  141:          A(I2,I2)=TMP
  142: *
  143:          CALL ZSWAP( I2-I1-1, A(I1,I1+1), LDA, A(I1+1,I2), 1 )
  144: *
  145: *          third swap
  146: *          - swap row I1 and I2 from I2+1 to N
  147:          IF ( I2.LT.N )
  148:      $      CALL ZSWAP( N-I2, A(I1,I2+1), LDA, A(I2,I2+1), LDA )
  149: *
  150:         ELSE
  151: *
  152: *         LOWER
  153: *         first swap
  154: *          - swap row I1 and I2 from I1 to I1-1
  155:          CALL ZSWAP( I1-1, A(I1,1), LDA, A(I2,1), LDA )
  156: *
  157: *         second swap :
  158: *          - swap A(I1,I1) and A(I2,I2)
  159: *          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1
  160:           TMP=A(I1,I1)
  161:           A(I1,I1)=A(I2,I2)
  162:           A(I2,I2)=TMP
  163: *
  164:           CALL ZSWAP( I2-I1-1, A(I1+1,I1), 1, A(I2,I1+1), LDA )
  165: *
  166: *         third swap
  167: *          - swap col I1 and I2 from I2+1 to N
  168:          IF ( I2.LT.N )
  169:      $      CALL ZSWAP( N-I2, A(I2+1,I1), 1, A(I2+1,I2), 1 )
  170: *
  171:       ENDIF
  172:       END SUBROUTINE ZSYSWAPR
  173: 

CVSweb interface <joel.bertrand@systella.fr>