LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dsyswapr.f
Go to the documentation of this file.
00001 *> \brief \b DSYSWAPR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DSYSWAPR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyswapr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyswapr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyswapr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER        UPLO
00025 *       INTEGER          I1, I2, LDA, N
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       DOUBLE PRECISION A( LDA, N )
00029 *  
00030 *
00031 *> \par Purpose:
00032 *  =============
00033 *>
00034 *> \verbatim
00035 *>
00036 *> DSYSWAPR applies an elementary permutation on the rows and the columns of
00037 *> a symmetric matrix.
00038 *> \endverbatim
00039 *
00040 *  Arguments:
00041 *  ==========
00042 *
00043 *> \param[in] UPLO
00044 *> \verbatim
00045 *>          UPLO is CHARACTER*1
00046 *>          Specifies whether the details of the factorization are stored
00047 *>          as an upper or lower triangular matrix.
00048 *>          = 'U':  Upper triangular, form is A = U*D*U**T;
00049 *>          = 'L':  Lower triangular, form is A = L*D*L**T.
00050 *> \endverbatim
00051 *>
00052 *> \param[in] N
00053 *> \verbatim
00054 *>          N is INTEGER
00055 *>          The order of the matrix A.  N >= 0.
00056 *> \endverbatim
00057 *>
00058 *> \param[in,out] A
00059 *> \verbatim
00060 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
00061 *>          On entry, the NB diagonal matrix D and the multipliers
00062 *>          used to obtain the factor U or L as computed by DSYTRF.
00063 *>
00064 *>          On exit, if INFO = 0, the (symmetric) inverse of the original
00065 *>          matrix.  If UPLO = 'U', the upper triangular part of the
00066 *>          inverse is formed and the part of A below the diagonal is not
00067 *>          referenced; if UPLO = 'L' the lower triangular part of the
00068 *>          inverse is formed and the part of A above the diagonal is
00069 *>          not referenced.
00070 *> \endverbatim
00071 *>
00072 *> \param[in] LDA
00073 *> \verbatim
00074 *>          LDA is INTEGER
00075 *>          The leading dimension of the array A.  LDA >= max(1,N).
00076 *> \endverbatim
00077 *>
00078 *> \param[in] I1
00079 *> \verbatim
00080 *>          I1 is INTEGER
00081 *>          Index of the first row to swap
00082 *> \endverbatim
00083 *>
00084 *> \param[in] I2
00085 *> \verbatim
00086 *>          I2 is INTEGER
00087 *>          Index of the second row to swap
00088 *> \endverbatim
00089 *
00090 *  Authors:
00091 *  ========
00092 *
00093 *> \author Univ. of Tennessee 
00094 *> \author Univ. of California Berkeley 
00095 *> \author Univ. of Colorado Denver 
00096 *> \author NAG Ltd. 
00097 *
00098 *> \date November 2011
00099 *
00100 *> \ingroup doubleSYauxiliary
00101 *
00102 *  =====================================================================
00103       SUBROUTINE DSYSWAPR( UPLO, N, A, LDA, I1, I2)
00104 *
00105 *  -- LAPACK auxiliary routine (version 3.4.0) --
00106 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00107 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00108 *     November 2011
00109 *
00110 *     .. Scalar Arguments ..
00111       CHARACTER        UPLO
00112       INTEGER          I1, I2, LDA, N
00113 *     ..
00114 *     .. Array Arguments ..
00115       DOUBLE PRECISION A( LDA, N )
00116 *
00117 *  =====================================================================
00118 *
00119 *     ..
00120 *     .. Local Scalars ..
00121       LOGICAL            UPPER
00122       INTEGER            I
00123       DOUBLE PRECISION   TMP
00124 *
00125 *     .. External Functions ..
00126       LOGICAL            LSAME
00127       EXTERNAL           LSAME
00128 *     ..
00129 *     .. External Subroutines ..
00130       EXTERNAL         DSWAP
00131 *     ..
00132 *     .. Executable Statements ..
00133 *
00134       UPPER = LSAME( UPLO, 'U' )
00135       IF (UPPER) THEN
00136 *
00137 *         UPPER
00138 *         first swap
00139 *          - swap column I1 and I2 from I1 to I1-1 
00140          CALL DSWAP( I1-1, A(1,I1), 1, A(1,I2), 1 )
00141 *
00142 *          second swap :
00143 *          - swap A(I1,I1) and A(I2,I2)
00144 *          - swap row I1 from I1+1 to I2-1 with col I2 from I1+1 to I2-1     
00145          TMP=A(I1,I1)
00146          A(I1,I1)=A(I2,I2)
00147          A(I2,I2)=TMP
00148 *
00149          DO I=1,I2-I1-1
00150             TMP=A(I1,I1+I)
00151             A(I1,I1+I)=A(I1+I,I2)
00152             A(I1+I,I2)=TMP
00153          END DO
00154 *
00155 *          third swap
00156 *          - swap row I1 and I2 from I2+1 to N
00157          DO I=I2+1,N
00158             TMP=A(I1,I)
00159             A(I1,I)=A(I2,I)
00160             A(I2,I)=TMP
00161          END DO
00162 *
00163         ELSE
00164 *
00165 *         LOWER
00166 *         first swap
00167 *          - swap row I1 and I2 from I1 to I1-1 
00168          CALL DSWAP( I1-1, A(I1,1), LDA, A(I2,1), LDA )
00169 *
00170 *         second swap :
00171 *          - swap A(I1,I1) and A(I2,I2)
00172 *          - swap col I1 from I1+1 to I2-1 with row I2 from I1+1 to I2-1     
00173           TMP=A(I1,I1)
00174           A(I1,I1)=A(I2,I2)
00175           A(I2,I2)=TMP
00176 *
00177           DO I=1,I2-I1-1
00178              TMP=A(I1+I,I1)
00179              A(I1+I,I1)=A(I2,I1+I)
00180              A(I2,I1+I)=TMP
00181           END DO
00182 *
00183 *         third swap
00184 *          - swap col I1 and I2 from I2+1 to N
00185           DO I=I2+1,N
00186              TMP=A(I,I1)
00187              A(I,I1)=A(I,I2)
00188              A(I,I2)=TMP
00189           END DO
00190 *
00191       ENDIF
00192       END SUBROUTINE DSYSWAPR
00193 
 All Files Functions