LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ slagts()

subroutine slagts ( integer  job,
integer  n,
real, dimension( * )  a,
real, dimension( * )  b,
real, dimension( * )  c,
real, dimension( * )  d,
integer, dimension( * )  in,
real, dimension( * )  y,
real  tol,
integer  info 
)

SLAGTS solves the system of equations (T-λI)x = y or (T-λI)^Tx = y, where T is a general tridiagonal matrix and λ a scalar, using the LU factorization computed by slagtf.

Download SLAGTS + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SLAGTS may be used to solve one of the systems of equations

    (T - lambda*I)*x = y   or   (T - lambda*I)**T*x = y,

 where T is an n by n tridiagonal matrix, for x, following the
 factorization of (T - lambda*I) as

    (T - lambda*I) = P*L*U ,

 by routine SLAGTF. The choice of equation to be solved is
 controlled by the argument JOB, and in each case there is an option
 to perturb zero or very small diagonal elements of U, this option
 being intended for use in applications such as inverse iteration.
Parameters
[in]JOB
          JOB is INTEGER
          Specifies the job to be performed by SLAGTS as follows:
          =  1: The equations  (T - lambda*I)x = y  are to be solved,
                but diagonal elements of U are not to be perturbed.
          = -1: The equations  (T - lambda*I)x = y  are to be solved
                and, if overflow would otherwise occur, the diagonal
                elements of U are to be perturbed. See argument TOL
                below.
          =  2: The equations  (T - lambda*I)**Tx = y  are to be solved,
                but diagonal elements of U are not to be perturbed.
          = -2: The equations  (T - lambda*I)**Tx = y  are to be solved
                and, if overflow would otherwise occur, the diagonal
                elements of U are to be perturbed. See argument TOL
                below.
[in]N
          N is INTEGER
          The order of the matrix T.
[in]A
          A is REAL array, dimension (N)
          On entry, A must contain the diagonal elements of U as
          returned from SLAGTF.
[in]B
          B is REAL array, dimension (N-1)
          On entry, B must contain the first super-diagonal elements of
          U as returned from SLAGTF.
[in]C
          C is REAL array, dimension (N-1)
          On entry, C must contain the sub-diagonal elements of L as
          returned from SLAGTF.
[in]D
          D is REAL array, dimension (N-2)
          On entry, D must contain the second super-diagonal elements
          of U as returned from SLAGTF.
[in]IN
          IN is INTEGER array, dimension (N)
          On entry, IN must contain details of the matrix P as returned
          from SLAGTF.
[in,out]Y
          Y is REAL array, dimension (N)
          On entry, the right hand side vector y.
          On exit, Y is overwritten by the solution vector x.
[in,out]TOL
          TOL is REAL
          On entry, with  JOB < 0, TOL should be the minimum
          perturbation to be made to very small diagonal elements of U.
          TOL should normally be chosen as about eps*norm(U), where eps
          is the relative machine precision, but if TOL is supplied as
          non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
          If  JOB > 0  then TOL is not referenced.

          On exit, TOL is changed as described above, only if TOL is
          non-positive on entry. Otherwise TOL is unchanged.
[out]INFO
          INFO is INTEGER
          = 0: successful exit
          < 0: if INFO = -i, the i-th argument had an illegal value
          > 0: overflow would occur when computing the INFO(th)
               element of the solution vector x. This can only occur
               when JOB is supplied as positive and either means
               that a diagonal element of U is very small, or that
               the elements of the right-hand side vector y are very
               large.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 162 of file slagts.f.

163*
164* -- LAPACK auxiliary routine --
165* -- LAPACK is a software package provided by Univ. of Tennessee, --
166* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
167*
168* .. Scalar Arguments ..
169 INTEGER INFO, JOB, N
170 REAL TOL
171* ..
172* .. Array Arguments ..
173 INTEGER IN( * )
174 REAL A( * ), B( * ), C( * ), D( * ), Y( * )
175* ..
176*
177* =====================================================================
178*
179* .. Parameters ..
180 REAL ONE, ZERO
181 parameter( one = 1.0e+0, zero = 0.0e+0 )
182* ..
183* .. Local Scalars ..
184 INTEGER K
185 REAL ABSAK, AK, BIGNUM, EPS, PERT, SFMIN, TEMP
186* ..
187* .. Intrinsic Functions ..
188 INTRINSIC abs, max, sign
189* ..
190* .. External Functions ..
191 REAL SLAMCH
192 EXTERNAL slamch
193* ..
194* .. External Subroutines ..
195 EXTERNAL xerbla
196* ..
197* .. Executable Statements ..
198*
199 info = 0
200 IF( ( abs( job ).GT.2 ) .OR. ( job.EQ.0 ) ) THEN
201 info = -1
202 ELSE IF( n.LT.0 ) THEN
203 info = -2
204 END IF
205 IF( info.NE.0 ) THEN
206 CALL xerbla( 'SLAGTS', -info )
207 RETURN
208 END IF
209*
210 IF( n.EQ.0 )
211 $ RETURN
212*
213 eps = slamch( 'Epsilon' )
214 sfmin = slamch( 'Safe minimum' )
215 bignum = one / sfmin
216*
217 IF( job.LT.0 ) THEN
218 IF( tol.LE.zero ) THEN
219 tol = abs( a( 1 ) )
220 IF( n.GT.1 )
221 $ tol = max( tol, abs( a( 2 ) ), abs( b( 1 ) ) )
222 DO 10 k = 3, n
223 tol = max( tol, abs( a( k ) ), abs( b( k-1 ) ),
224 $ abs( d( k-2 ) ) )
225 10 CONTINUE
226 tol = tol*eps
227 IF( tol.EQ.zero )
228 $ tol = eps
229 END IF
230 END IF
231*
232 IF( abs( job ).EQ.1 ) THEN
233 DO 20 k = 2, n
234 IF( in( k-1 ).EQ.0 ) THEN
235 y( k ) = y( k ) - c( k-1 )*y( k-1 )
236 ELSE
237 temp = y( k-1 )
238 y( k-1 ) = y( k )
239 y( k ) = temp - c( k-1 )*y( k )
240 END IF
241 20 CONTINUE
242 IF( job.EQ.1 ) THEN
243 DO 30 k = n, 1, -1
244 IF( k.LE.n-2 ) THEN
245 temp = y( k ) - b( k )*y( k+1 ) - d( k )*y( k+2 )
246 ELSE IF( k.EQ.n-1 ) THEN
247 temp = y( k ) - b( k )*y( k+1 )
248 ELSE
249 temp = y( k )
250 END IF
251 ak = a( k )
252 absak = abs( ak )
253 IF( absak.LT.one ) THEN
254 IF( absak.LT.sfmin ) THEN
255 IF( absak.EQ.zero .OR. abs( temp )*sfmin.GT.absak )
256 $ THEN
257 info = k
258 RETURN
259 ELSE
260 temp = temp*bignum
261 ak = ak*bignum
262 END IF
263 ELSE IF( abs( temp ).GT.absak*bignum ) THEN
264 info = k
265 RETURN
266 END IF
267 END IF
268 y( k ) = temp / ak
269 30 CONTINUE
270 ELSE
271 DO 50 k = n, 1, -1
272 IF( k.LE.n-2 ) THEN
273 temp = y( k ) - b( k )*y( k+1 ) - d( k )*y( k+2 )
274 ELSE IF( k.EQ.n-1 ) THEN
275 temp = y( k ) - b( k )*y( k+1 )
276 ELSE
277 temp = y( k )
278 END IF
279 ak = a( k )
280 pert = sign( tol, ak )
281 40 CONTINUE
282 absak = abs( ak )
283 IF( absak.LT.one ) THEN
284 IF( absak.LT.sfmin ) THEN
285 IF( absak.EQ.zero .OR. abs( temp )*sfmin.GT.absak )
286 $ THEN
287 ak = ak + pert
288 pert = 2*pert
289 GO TO 40
290 ELSE
291 temp = temp*bignum
292 ak = ak*bignum
293 END IF
294 ELSE IF( abs( temp ).GT.absak*bignum ) THEN
295 ak = ak + pert
296 pert = 2*pert
297 GO TO 40
298 END IF
299 END IF
300 y( k ) = temp / ak
301 50 CONTINUE
302 END IF
303 ELSE
304*
305* Come to here if JOB = 2 or -2
306*
307 IF( job.EQ.2 ) THEN
308 DO 60 k = 1, n
309 IF( k.GE.3 ) THEN
310 temp = y( k ) - b( k-1 )*y( k-1 ) - d( k-2 )*y( k-2 )
311 ELSE IF( k.EQ.2 ) THEN
312 temp = y( k ) - b( k-1 )*y( k-1 )
313 ELSE
314 temp = y( k )
315 END IF
316 ak = a( k )
317 absak = abs( ak )
318 IF( absak.LT.one ) THEN
319 IF( absak.LT.sfmin ) THEN
320 IF( absak.EQ.zero .OR. abs( temp )*sfmin.GT.absak )
321 $ THEN
322 info = k
323 RETURN
324 ELSE
325 temp = temp*bignum
326 ak = ak*bignum
327 END IF
328 ELSE IF( abs( temp ).GT.absak*bignum ) THEN
329 info = k
330 RETURN
331 END IF
332 END IF
333 y( k ) = temp / ak
334 60 CONTINUE
335 ELSE
336 DO 80 k = 1, n
337 IF( k.GE.3 ) THEN
338 temp = y( k ) - b( k-1 )*y( k-1 ) - d( k-2 )*y( k-2 )
339 ELSE IF( k.EQ.2 ) THEN
340 temp = y( k ) - b( k-1 )*y( k-1 )
341 ELSE
342 temp = y( k )
343 END IF
344 ak = a( k )
345 pert = sign( tol, ak )
346 70 CONTINUE
347 absak = abs( ak )
348 IF( absak.LT.one ) THEN
349 IF( absak.LT.sfmin ) THEN
350 IF( absak.EQ.zero .OR. abs( temp )*sfmin.GT.absak )
351 $ THEN
352 ak = ak + pert
353 pert = 2*pert
354 GO TO 70
355 ELSE
356 temp = temp*bignum
357 ak = ak*bignum
358 END IF
359 ELSE IF( abs( temp ).GT.absak*bignum ) THEN
360 ak = ak + pert
361 pert = 2*pert
362 GO TO 70
363 END IF
364 END IF
365 y( k ) = temp / ak
366 80 CONTINUE
367 END IF
368*
369 DO 90 k = n, 2, -1
370 IF( in( k-1 ).EQ.0 ) THEN
371 y( k-1 ) = y( k-1 ) - c( k-1 )*y( k )
372 ELSE
373 temp = y( k-1 )
374 y( k-1 ) = y( k )
375 y( k ) = temp - c( k-1 )*y( k )
376 END IF
377 90 CONTINUE
378 END IF
379*
380* End of SLAGTS
381*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: