1 SUBROUTINE STRSVF ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) 2* .. Scalar Arguments .. 3 INTEGER INCX, LDA, N 4 CHARACTER*1 DIAG, TRANS, UPLO 5* .. Array Arguments .. 6 REAL A( LDA, * ), X( * ) 7* .. 8* 9* Purpose 10* ======= 11* 12* STRSV solves one of the systems of equations 13* 14* A*x = b, or A'*x = b, 15* 16* where b and x are n element vectors and A is an n by n unit, or 17* non-unit, upper or lower triangular matrix. 18* 19* No test for singularity or near-singularity is included in this 20* routine. Such tests must be performed before calling this routine. 21* 22* Parameters 23* ========== 24* 25* UPLO - CHARACTER*1. 26* On entry, UPLO specifies whether the matrix is an upper or 27* lower triangular matrix as follows: 28* 29* UPLO = 'U' or 'u' A is an upper triangular matrix. 30* 31* UPLO = 'L' or 'l' A is a lower triangular matrix. 32* 33* Unchanged on exit. 34* 35* TRANS - CHARACTER*1. 36* On entry, TRANS specifies the equations to be solved as 37* follows: 38* 39* TRANS = 'N' or 'n' A*x = b. 40* 41* TRANS = 'T' or 't' A'*x = b. 42* 43* TRANS = 'C' or 'c' A'*x = b. 44* 45* Unchanged on exit. 46* 47* DIAG - CHARACTER*1. 48* On entry, DIAG specifies whether or not A is unit 49* triangular as follows: 50* 51* DIAG = 'U' or 'u' A is assumed to be unit triangular. 52* 53* DIAG = 'N' or 'n' A is not assumed to be unit 54* triangular. 55* 56* Unchanged on exit. 57* 58* N - INTEGER. 59* On entry, N specifies the order of the matrix A. 60* N must be at least zero. 61* Unchanged on exit. 62* 63* A - REAL array of DIMENSION ( LDA, n ). 64* Before entry with UPLO = 'U' or 'u', the leading n by n 65* upper triangular part of the array A must contain the upper 66* triangular matrix and the strictly lower triangular part of 67* A is not referenced. 68* Before entry with UPLO = 'L' or 'l', the leading n by n 69* lower triangular part of the array A must contain the lower 70* triangular matrix and the strictly upper triangular part of 71* A is not referenced. 72* Note that when DIAG = 'U' or 'u', the diagonal elements of 73* A are not referenced either, but are assumed to be unity. 74* Unchanged on exit. 75* 76* LDA - INTEGER. 77* On entry, LDA specifies the first dimension of A as declared 78* in the calling (sub) program. LDA must be at least 79* max( 1, n ). 80* Unchanged on exit. 81* 82* X - REAL array of dimension at least 83* ( 1 + ( n - 1 )*abs( INCX ) ). 84* Before entry, the incremented array X must contain the n 85* element right-hand side vector b. On exit, X is overwritten 86* with the solution vector x. 87* 88* INCX - INTEGER. 89* On entry, INCX specifies the increment for the elements of 90* X. INCX must not be zero. 91* Unchanged on exit. 92* 93* 94* Level 2 Blas routine. 95* 96* -- Written on 22-October-1986. 97* Jack Dongarra, Argonne National Lab. 98* Jeremy Du Croz, Nag Central Office. 99* Sven Hammarling, Nag Central Office. 100* Richard Hanson, Sandia National Labs. 101* 102* 103* .. Parameters .. 104 REAL ZERO 105 PARAMETER ( ZERO = 0.0E+0 ) 106* .. Local Scalars .. 107 REAL TEMP 108 INTEGER I, INFO, IX, J, JX, KX 109 LOGICAL NOUNIT 110* .. External Functions .. 111 LOGICAL LSAME 112 EXTERNAL LSAME 113* .. External Subroutines .. 114 EXTERNAL XERBLA 115* .. Intrinsic Functions .. 116 INTRINSIC MAX 117* .. 118* .. Executable Statements .. 119* 120* Test the input parameters. 121* 122 INFO = 0 123 IF ( .NOT.LSAME( UPLO , 'U' ).AND. 124 $ .NOT.LSAME( UPLO , 'L' ) )THEN 125 INFO = 1 126 ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND. 127 $ .NOT.LSAME( TRANS, 'T' ).AND. 128 $ .NOT.LSAME( TRANS, 'C' ) )THEN 129 INFO = 2 130 ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND. 131 $ .NOT.LSAME( DIAG , 'N' ) )THEN 132 INFO = 3 133 ELSE IF( N.LT.0 )THEN 134 INFO = 4 135 ELSE IF( LDA.LT.MAX( 1, N ) )THEN 136 INFO = 6 137 ELSE IF( INCX.EQ.0 )THEN 138 INFO = 8 139 END IF 140 IF( INFO.NE.0 )THEN 141 CALL XERBLA( 'STRSV ', INFO ) 142 RETURN 143 END IF 144* 145* Quick return if possible. 146* 147 IF( N.EQ.0 ) 148 $ RETURN 149* 150 NOUNIT = LSAME( DIAG, 'N' ) 151* 152* Set up the start point in X if the increment is not unity. This 153* will be ( N - 1 )*INCX too small for descending loops. 154* 155 IF( INCX.LE.0 )THEN 156 KX = 1 - ( N - 1 )*INCX 157 ELSE IF( INCX.NE.1 )THEN 158 KX = 1 159 END IF 160* 161* Start the operations. In this version the elements of A are 162* accessed sequentially with one pass through A. 163* 164 IF( LSAME( TRANS, 'N' ) )THEN 165* 166* Form x := inv( A )*x. 167* 168 IF( LSAME( UPLO, 'U' ) )THEN 169 IF( INCX.EQ.1 )THEN 170 DO 20, J = N, 1, -1 171 IF( X( J ).NE.ZERO )THEN 172 IF( NOUNIT ) 173 $ X( J ) = X( J )/A( J, J ) 174 TEMP = X( J ) 175 DO 10, I = J - 1, 1, -1 176 X( I ) = X( I ) - TEMP*A( I, J ) 177 10 CONTINUE 178 END IF 179 20 CONTINUE 180 ELSE 181 JX = KX + ( N - 1 )*INCX 182 DO 40, J = N, 1, -1 183 IF( X( JX ).NE.ZERO )THEN 184 IF( NOUNIT ) 185 $ X( JX ) = X( JX )/A( J, J ) 186 TEMP = X( JX ) 187 IX = JX 188 DO 30, I = J - 1, 1, -1 189 IX = IX - INCX 190 X( IX ) = X( IX ) - TEMP*A( I, J ) 191 30 CONTINUE 192 END IF 193 JX = JX - INCX 194 40 CONTINUE 195 END IF 196 ELSE 197 IF( INCX.EQ.1 )THEN 198 DO 60, J = 1, N 199 IF( X( J ).NE.ZERO )THEN 200 IF( NOUNIT ) 201 $ X( J ) = X( J )/A( J, J ) 202 TEMP = X( J ) 203 DO 50, I = J + 1, N 204 X( I ) = X( I ) - TEMP*A( I, J ) 205 50 CONTINUE 206 END IF 207 60 CONTINUE 208 ELSE 209 JX = KX 210 DO 80, J = 1, N 211 IF( X( JX ).NE.ZERO )THEN 212 IF( NOUNIT ) 213 $ X( JX ) = X( JX )/A( J, J ) 214 TEMP = X( JX ) 215 IX = JX 216 DO 70, I = J + 1, N 217 IX = IX + INCX 218 X( IX ) = X( IX ) - TEMP*A( I, J ) 219 70 CONTINUE 220 END IF 221 JX = JX + INCX 222 80 CONTINUE 223 END IF 224 END IF 225 ELSE 226* 227* Form x := inv( A' )*x. 228* 229 IF( LSAME( UPLO, 'U' ) )THEN 230 IF( INCX.EQ.1 )THEN 231 DO 100, J = 1, N 232 TEMP = X( J ) 233 DO 90, I = 1, J - 1 234 TEMP = TEMP - A( I, J )*X( I ) 235 90 CONTINUE 236 IF( NOUNIT ) 237 $ TEMP = TEMP/A( J, J ) 238 X( J ) = TEMP 239 100 CONTINUE 240 ELSE 241 JX = KX 242 DO 120, J = 1, N 243 TEMP = X( JX ) 244 IX = KX 245 DO 110, I = 1, J - 1 246 TEMP = TEMP - A( I, J )*X( IX ) 247 IX = IX + INCX 248 110 CONTINUE 249 IF( NOUNIT ) 250 $ TEMP = TEMP/A( J, J ) 251 X( JX ) = TEMP 252 JX = JX + INCX 253 120 CONTINUE 254 END IF 255 ELSE 256 IF( INCX.EQ.1 )THEN 257 DO 140, J = N, 1, -1 258 TEMP = X( J ) 259 DO 130, I = N, J + 1, -1 260 TEMP = TEMP - A( I, J )*X( I ) 261 130 CONTINUE 262 IF( NOUNIT ) 263 $ TEMP = TEMP/A( J, J ) 264 X( J ) = TEMP 265 140 CONTINUE 266 ELSE 267 KX = KX + ( N - 1 )*INCX 268 JX = KX 269 DO 160, J = N, 1, -1 270 TEMP = X( JX ) 271 IX = KX 272 DO 150, I = N, J + 1, -1 273 TEMP = TEMP - A( I, J )*X( IX ) 274 IX = IX - INCX 275 150 CONTINUE 276 IF( NOUNIT ) 277 $ TEMP = TEMP/A( J, J ) 278 X( JX ) = TEMP 279 JX = JX - INCX 280 160 CONTINUE 281 END IF 282 END IF 283 END IF 284* 285 RETURN 286* 287* End of STRSV . 288* 289 END 290