![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAROT 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, 00012 * XRIGHT ) 00013 * 00014 * .. Scalar Arguments .. 00015 * LOGICAL LLEFT, LRIGHT, LROWS 00016 * INTEGER LDA, NL 00017 * REAL C, S, XLEFT, XRIGHT 00018 * .. 00019 * .. Array Arguments .. 00020 * REAL A( * ) 00021 * .. 00022 * 00023 * 00024 *> \par Purpose: 00025 * ============= 00026 *> 00027 *> \verbatim 00028 *> 00029 *> SLAROT applies a (Givens) rotation to two adjacent rows or 00030 *> columns, where one element of the first and/or last column/row 00031 *> for use on matrices stored in some format other than GE, so 00032 *> that elements of the matrix may be used or modified for which 00033 *> no array element is provided. 00034 *> 00035 *> One example is a symmetric matrix in SB format (bandwidth=4), for 00036 *> which UPLO='L': Two adjacent rows will have the format: 00037 *> 00038 *> row j: C> C> C> C> C> . . . . 00039 *> row j+1: C> C> C> C> C> . . . . 00040 *> 00041 *> '*' indicates elements for which storage is provided, 00042 *> '.' indicates elements for which no storage is provided, but 00043 *> are not necessarily zero; their values are determined by 00044 *> symmetry. ' ' indicates elements which are necessarily zero, 00045 *> and have no storage provided. 00046 *> 00047 *> Those columns which have two '*'s can be handled by SROT. 00048 *> Those columns which have no '*'s can be ignored, since as long 00049 *> as the Givens rotations are carefully applied to preserve 00050 *> symmetry, their values are determined. 00051 *> Those columns which have one '*' have to be handled separately, 00052 *> by using separate variables "p" and "q": 00053 *> 00054 *> row j: C> C> C> C> C> p . . . 00055 *> row j+1: q C> C> C> C> C> . . . . 00056 *> 00057 *> The element p would have to be set correctly, then that column 00058 *> is rotated, setting p to its new value. The next call to 00059 *> SLAROT would rotate columns j and j+1, using p, and restore 00060 *> symmetry. The element q would start out being zero, and be 00061 *> made non-zero by the rotation. Later, rotations would presumably 00062 *> be chosen to zero q out. 00063 *> 00064 *> Typical Calling Sequences: rotating the i-th and (i+1)-st rows. 00065 *> ------- ------- --------- 00066 *> 00067 *> General dense matrix: 00068 *> 00069 *> CALL SLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S, 00070 *> A(i,1),LDA, DUMMY, DUMMY) 00071 *> 00072 *> General banded matrix in GB format: 00073 *> 00074 *> j = MAX(1, i-KL ) 00075 *> NL = MIN( N, i+KU+1 ) + 1-j 00076 *> CALL SLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S, 00077 *> A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT ) 00078 *> 00079 *> [ note that i+1-j is just MIN(i,KL+1) ] 00080 *> 00081 *> Symmetric banded matrix in SY format, bandwidth K, 00082 *> lower triangle only: 00083 *> 00084 *> j = MAX(1, i-K ) 00085 *> NL = MIN( K+1, i ) + 1 00086 *> CALL SLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S, 00087 *> A(i,j), LDA, XLEFT, XRIGHT ) 00088 *> 00089 *> Same, but upper triangle only: 00090 *> 00091 *> NL = MIN( K+1, N-i ) + 1 00092 *> CALL SLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S, 00093 *> A(i,i), LDA, XLEFT, XRIGHT ) 00094 *> 00095 *> Symmetric banded matrix in SB format, bandwidth K, 00096 *> lower triangle only: 00097 *> 00098 *> [ same as for SY, except:] 00099 *> . . . . 00100 *> A(i+1-j,j), LDA-1, XLEFT, XRIGHT ) 00101 *> 00102 *> [ note that i+1-j is just MIN(i,K+1) ] 00103 *> 00104 *> Same, but upper triangle only: 00105 *> . . . 00106 *> A(K+1,i), LDA-1, XLEFT, XRIGHT ) 00107 *> 00108 *> Rotating columns is just the transpose of rotating rows, except 00109 *> for GB and SB: (rotating columns i and i+1) 00110 *> 00111 *> GB: 00112 *> j = MAX(1, i-KU ) 00113 *> NL = MIN( N, i+KL+1 ) + 1-j 00114 *> CALL SLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S, 00115 *> A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM ) 00116 *> 00117 *> [note that KU+j+1-i is just MAX(1,KU+2-i)] 00118 *> 00119 *> SB: (upper triangle) 00120 *> 00121 *> . . . . . . 00122 *> A(K+j+1-i,i),LDA-1, XTOP, XBOTTM ) 00123 *> 00124 *> SB: (lower triangle) 00125 *> 00126 *> . . . . . . 00127 *> A(1,i),LDA-1, XTOP, XBOTTM ) 00128 *> \endverbatim 00129 * 00130 * Arguments: 00131 * ========== 00132 * 00133 *> \verbatim 00134 *> LROWS - LOGICAL 00135 *> If .TRUE., then SLAROT will rotate two rows. If .FALSE., 00136 *> then it will rotate two columns. 00137 *> Not modified. 00138 *> 00139 *> LLEFT - LOGICAL 00140 *> If .TRUE., then XLEFT will be used instead of the 00141 *> corresponding element of A for the first element in the 00142 *> second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) 00143 *> If .FALSE., then the corresponding element of A will be 00144 *> used. 00145 *> Not modified. 00146 *> 00147 *> LRIGHT - LOGICAL 00148 *> If .TRUE., then XRIGHT will be used instead of the 00149 *> corresponding element of A for the last element in the 00150 *> first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If 00151 *> .FALSE., then the corresponding element of A will be used. 00152 *> Not modified. 00153 *> 00154 *> NL - INTEGER 00155 *> The length of the rows (if LROWS=.TRUE.) or columns (if 00156 *> LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are 00157 *> used, the columns/rows they are in should be included in 00158 *> NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at 00159 *> least 2. The number of rows/columns to be rotated 00160 *> exclusive of those involving XLEFT and/or XRIGHT may 00161 *> not be negative, i.e., NL minus how many of LLEFT and 00162 *> LRIGHT are .TRUE. must be at least zero; if not, XERBLA 00163 *> will be called. 00164 *> Not modified. 00165 *> 00166 *> C, S - REAL 00167 *> Specify the Givens rotation to be applied. If LROWS is 00168 *> true, then the matrix ( c s ) 00169 *> (-s c ) is applied from the left; 00170 *> if false, then the transpose thereof is applied from the 00171 *> right. For a Givens rotation, C**2 + S**2 should be 1, 00172 *> but this is not checked. 00173 *> Not modified. 00174 *> 00175 *> A - REAL array. 00176 *> The array containing the rows/columns to be rotated. The 00177 *> first element of A should be the upper left element to 00178 *> be rotated. 00179 *> Read and modified. 00180 *> 00181 *> LDA - INTEGER 00182 *> The "effective" leading dimension of A. If A contains 00183 *> a matrix stored in GE or SY format, then this is just 00184 *> the leading dimension of A as dimensioned in the calling 00185 *> routine. If A contains a matrix stored in band (GB or SB) 00186 *> format, then this should be *one less* than the leading 00187 *> dimension used in the calling routine. Thus, if 00188 *> A were dimensioned A(LDA,*) in SLAROT, then A(1,j) would 00189 *> be the j-th element in the first of the two rows 00190 *> to be rotated, and A(2,j) would be the j-th in the second, 00191 *> regardless of how the array may be stored in the calling 00192 *> routine. [A cannot, however, actually be dimensioned thus, 00193 *> since for band format, the row number may exceed LDA, which 00194 *> is not legal FORTRAN.] 00195 *> If LROWS=.TRUE., then LDA must be at least 1, otherwise 00196 *> it must be at least NL minus the number of .TRUE. values 00197 *> in XLEFT and XRIGHT. 00198 *> Not modified. 00199 *> 00200 *> XLEFT - REAL 00201 *> If LLEFT is .TRUE., then XLEFT will be used and modified 00202 *> instead of A(2,1) (if LROWS=.TRUE.) or A(1,2) 00203 *> (if LROWS=.FALSE.). 00204 *> Read and modified. 00205 *> 00206 *> XRIGHT - REAL 00207 *> If LRIGHT is .TRUE., then XRIGHT will be used and modified 00208 *> instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1) 00209 *> (if LROWS=.FALSE.). 00210 *> Read and modified. 00211 *> \endverbatim 00212 * 00213 * Authors: 00214 * ======== 00215 * 00216 *> \author Univ. of Tennessee 00217 *> \author Univ. of California Berkeley 00218 *> \author Univ. of Colorado Denver 00219 *> \author NAG Ltd. 00220 * 00221 *> \date November 2011 00222 * 00223 *> \ingroup real_matgen 00224 * 00225 * ===================================================================== 00226 SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, 00227 $ XRIGHT ) 00228 * 00229 * -- LAPACK auxiliary routine (version 3.4.0) -- 00230 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00231 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00232 * November 2011 00233 * 00234 * .. Scalar Arguments .. 00235 LOGICAL LLEFT, LRIGHT, LROWS 00236 INTEGER LDA, NL 00237 REAL C, S, XLEFT, XRIGHT 00238 * .. 00239 * .. Array Arguments .. 00240 REAL A( * ) 00241 * .. 00242 * 00243 * ===================================================================== 00244 * 00245 * .. Local Scalars .. 00246 INTEGER IINC, INEXT, IX, IY, IYT, NT 00247 * .. 00248 * .. Local Arrays .. 00249 REAL XT( 2 ), YT( 2 ) 00250 * .. 00251 * .. External Subroutines .. 00252 EXTERNAL SROT, XERBLA 00253 * .. 00254 * .. Executable Statements .. 00255 * 00256 * Set up indices, arrays for ends 00257 * 00258 IF( LROWS ) THEN 00259 IINC = LDA 00260 INEXT = 1 00261 ELSE 00262 IINC = 1 00263 INEXT = LDA 00264 END IF 00265 * 00266 IF( LLEFT ) THEN 00267 NT = 1 00268 IX = 1 + IINC 00269 IY = 2 + LDA 00270 XT( 1 ) = A( 1 ) 00271 YT( 1 ) = XLEFT 00272 ELSE 00273 NT = 0 00274 IX = 1 00275 IY = 1 + INEXT 00276 END IF 00277 * 00278 IF( LRIGHT ) THEN 00279 IYT = 1 + INEXT + ( NL-1 )*IINC 00280 NT = NT + 1 00281 XT( NT ) = XRIGHT 00282 YT( NT ) = A( IYT ) 00283 END IF 00284 * 00285 * Check for errors 00286 * 00287 IF( NL.LT.NT ) THEN 00288 CALL XERBLA( 'SLAROT', 4 ) 00289 RETURN 00290 END IF 00291 IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN 00292 CALL XERBLA( 'SLAROT', 8 ) 00293 RETURN 00294 END IF 00295 * 00296 * Rotate 00297 * 00298 CALL SROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S ) 00299 CALL SROT( NT, XT, 1, YT, 1, C, S ) 00300 * 00301 * Stuff values back into XLEFT, XRIGHT, etc. 00302 * 00303 IF( LLEFT ) THEN 00304 A( 1 ) = XT( 1 ) 00305 XLEFT = YT( 1 ) 00306 END IF 00307 * 00308 IF( LRIGHT ) THEN 00309 XRIGHT = XT( NT ) 00310 A( IYT ) = YT( NT ) 00311 END IF 00312 * 00313 RETURN 00314 * 00315 * End of SLAROT 00316 * 00317 END