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