LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ slatps()

subroutine slatps ( character  UPLO,
character  TRANS,
character  DIAG,
character  NORMIN,
integer  N,
real, dimension( * )  AP,
real, dimension( * )  X,
real  SCALE,
real, dimension( * )  CNORM,
integer  INFO 
)

SLATPS solves a triangular system of equations with the matrix held in packed storage.

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

Purpose:
 SLATPS solves one of the triangular systems

    A *x = s*b  or  A**T*x = s*b

 with scaling to prevent overflow, where A is an upper or lower
 triangular matrix stored in packed form.  Here A**T denotes the
 transpose of A, x and b are n-element vectors, and s is a scaling
 factor, usually less than or equal to 1, chosen so that the
 components of x will be less than the overflow threshold.  If the
 unscaled problem will not cause overflow, the Level 2 BLAS routine
 STPSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
 then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the matrix A is upper or lower triangular.
          = 'U':  Upper triangular
          = 'L':  Lower triangular
[in]TRANS
          TRANS is CHARACTER*1
          Specifies the operation applied to A.
          = 'N':  Solve A * x = s*b  (No transpose)
          = 'T':  Solve A**T* x = s*b  (Transpose)
          = 'C':  Solve A**T* x = s*b  (Conjugate transpose = Transpose)
[in]DIAG
          DIAG is CHARACTER*1
          Specifies whether or not the matrix A is unit triangular.
          = 'N':  Non-unit triangular
          = 'U':  Unit triangular
[in]NORMIN
          NORMIN is CHARACTER*1
          Specifies whether CNORM has been set or not.
          = 'Y':  CNORM contains the column norms on entry
          = 'N':  CNORM is not set on entry.  On exit, the norms will
                  be computed and stored in CNORM.
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in]AP
          AP is REAL array, dimension (N*(N+1)/2)
          The upper or lower triangular matrix A, packed columnwise in
          a linear array.  The j-th column of A is stored in the array
          AP as follows:
          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
[in,out]X
          X is REAL array, dimension (N)
          On entry, the right hand side b of the triangular system.
          On exit, X is overwritten by the solution vector x.
[out]SCALE
          SCALE is REAL
          The scaling factor s for the triangular system
             A * x = s*b  or  A**T* x = s*b.
          If SCALE = 0, the matrix A is singular or badly scaled, and
          the vector x is an exact or approximate solution to A*x = 0.
[in,out]CNORM
          CNORM is REAL array, dimension (N)

          If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
          contains the norm of the off-diagonal part of the j-th column
          of A.  If TRANS = 'N', CNORM(j) must be greater than or equal
          to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
          must be greater than or equal to the 1-norm.

          If NORMIN = 'N', CNORM is an output argument and CNORM(j)
          returns the 1-norm of the offdiagonal part of the j-th column
          of A.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -k, the k-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  A rough bound on x is computed; if that is less than overflow, STPSV
  is called, otherwise, specific code is used which checks for possible
  overflow or divide-by-zero at every operation.

  A columnwise scheme is used for solving A*x = b.  The basic algorithm
  if A is lower triangular is

       x[1:n] := b[1:n]
       for j = 1, ..., n
            x(j) := x(j) / A(j,j)
            x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
       end

  Define bounds on the components of x after j iterations of the loop:
     M(j) = bound on x[1:j]
     G(j) = bound on x[j+1:n]
  Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.

  Then for iteration j+1 we have
     M(j+1) <= G(j) / | A(j+1,j+1) |
     G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
            <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )

  where CNORM(j+1) is greater than or equal to the infinity-norm of
  column j+1 of A, not counting the diagonal.  Hence

     G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
                  1<=i<=j
  and

     |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
                                   1<=i< j

  Since |x(j)| <= M(j), we use the Level 2 BLAS routine STPSV if the
  reciprocal of the largest M(j), j=1,..,n, is larger than
  max(underflow, 1/overflow).

  The bound on x(j) is also used to determine when a step in the
  columnwise method can be performed without fear of overflow.  If
  the computed bound is greater than a large constant, x is scaled to
  prevent overflow, but if the bound overflows, x is set to 0, x(j) to
  1, and scale to 0, and a non-trivial solution to A*x = 0 is found.

  Similarly, a row-wise scheme is used to solve A**T*x = b.  The basic
  algorithm for A upper triangular is

       for j = 1, ..., n
            x(j) := ( b(j) - A[1:j-1,j]**T * x[1:j-1] ) / A(j,j)
       end

  We simultaneously compute two bounds
       G(j) = bound on ( b(i) - A[1:i-1,i]**T * x[1:i-1] ), 1<=i<=j
       M(j) = bound on x(i), 1<=i<=j

  The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
  add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
  Then the bound on x(j) is

       M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |

            <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
                      1<=i<=j

  and we can safely call STPSV if 1/M(n) and 1/G(n) are both greater
  than max(underflow, 1/overflow).

Definition at line 227 of file slatps.f.

229 *
230 * -- LAPACK auxiliary routine --
231 * -- LAPACK is a software package provided by Univ. of Tennessee, --
232 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
233 *
234 * .. Scalar Arguments ..
235  CHARACTER DIAG, NORMIN, TRANS, UPLO
236  INTEGER INFO, N
237  REAL SCALE
238 * ..
239 * .. Array Arguments ..
240  REAL AP( * ), CNORM( * ), X( * )
241 * ..
242 *
243 * =====================================================================
244 *
245 * .. Parameters ..
246  REAL ZERO, HALF, ONE
247  parameter( zero = 0.0e+0, half = 0.5e+0, one = 1.0e+0 )
248 * ..
249 * .. Local Scalars ..
250  LOGICAL NOTRAN, NOUNIT, UPPER
251  INTEGER I, IMAX, IP, J, JFIRST, JINC, JLAST, JLEN
252  REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
253  $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
254 * ..
255 * .. External Functions ..
256  LOGICAL LSAME
257  INTEGER ISAMAX
258  REAL SASUM, SDOT, SLAMCH
259  EXTERNAL lsame, isamax, sasum, sdot, slamch
260 * ..
261 * .. External Subroutines ..
262  EXTERNAL saxpy, sscal, stpsv, xerbla
263 * ..
264 * .. Intrinsic Functions ..
265  INTRINSIC abs, max, min
266 * ..
267 * .. Executable Statements ..
268 *
269  info = 0
270  upper = lsame( uplo, 'U' )
271  notran = lsame( trans, 'N' )
272  nounit = lsame( diag, 'N' )
273 *
274 * Test the input parameters.
275 *
276  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
277  info = -1
278  ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) .AND. .NOT.
279  $ lsame( trans, 'C' ) ) THEN
280  info = -2
281  ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag, 'U' ) ) THEN
282  info = -3
283  ELSE IF( .NOT.lsame( normin, 'Y' ) .AND. .NOT.
284  $ lsame( normin, 'N' ) ) THEN
285  info = -4
286  ELSE IF( n.LT.0 ) THEN
287  info = -5
288  END IF
289  IF( info.NE.0 ) THEN
290  CALL xerbla( 'SLATPS', -info )
291  RETURN
292  END IF
293 *
294 * Quick return if possible
295 *
296  IF( n.EQ.0 )
297  $ RETURN
298 *
299 * Determine machine dependent parameters to control overflow.
300 *
301  smlnum = slamch( 'Safe minimum' ) / slamch( 'Precision' )
302  bignum = one / smlnum
303  scale = one
304 *
305  IF( lsame( normin, 'N' ) ) THEN
306 *
307 * Compute the 1-norm of each column, not including the diagonal.
308 *
309  IF( upper ) THEN
310 *
311 * A is upper triangular.
312 *
313  ip = 1
314  DO 10 j = 1, n
315  cnorm( j ) = sasum( j-1, ap( ip ), 1 )
316  ip = ip + j
317  10 CONTINUE
318  ELSE
319 *
320 * A is lower triangular.
321 *
322  ip = 1
323  DO 20 j = 1, n - 1
324  cnorm( j ) = sasum( n-j, ap( ip+1 ), 1 )
325  ip = ip + n - j + 1
326  20 CONTINUE
327  cnorm( n ) = zero
328  END IF
329  END IF
330 *
331 * Scale the column norms by TSCAL if the maximum element in CNORM is
332 * greater than BIGNUM.
333 *
334  imax = isamax( n, cnorm, 1 )
335  tmax = cnorm( imax )
336  IF( tmax.LE.bignum ) THEN
337  tscal = one
338  ELSE
339  tscal = one / ( smlnum*tmax )
340  CALL sscal( n, tscal, cnorm, 1 )
341  END IF
342 *
343 * Compute a bound on the computed solution vector to see if the
344 * Level 2 BLAS routine STPSV can be used.
345 *
346  j = isamax( n, x, 1 )
347  xmax = abs( x( j ) )
348  xbnd = xmax
349  IF( notran ) THEN
350 *
351 * Compute the growth in A * x = b.
352 *
353  IF( upper ) THEN
354  jfirst = n
355  jlast = 1
356  jinc = -1
357  ELSE
358  jfirst = 1
359  jlast = n
360  jinc = 1
361  END IF
362 *
363  IF( tscal.NE.one ) THEN
364  grow = zero
365  GO TO 50
366  END IF
367 *
368  IF( nounit ) THEN
369 *
370 * A is non-unit triangular.
371 *
372 * Compute GROW = 1/G(j) and XBND = 1/M(j).
373 * Initially, G(0) = max{x(i), i=1,...,n}.
374 *
375  grow = one / max( xbnd, smlnum )
376  xbnd = grow
377  ip = jfirst*( jfirst+1 ) / 2
378  jlen = n
379  DO 30 j = jfirst, jlast, jinc
380 *
381 * Exit the loop if the growth factor is too small.
382 *
383  IF( grow.LE.smlnum )
384  $ GO TO 50
385 *
386 * M(j) = G(j-1) / abs(A(j,j))
387 *
388  tjj = abs( ap( ip ) )
389  xbnd = min( xbnd, min( one, tjj )*grow )
390  IF( tjj+cnorm( j ).GE.smlnum ) THEN
391 *
392 * G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
393 *
394  grow = grow*( tjj / ( tjj+cnorm( j ) ) )
395  ELSE
396 *
397 * G(j) could overflow, set GROW to 0.
398 *
399  grow = zero
400  END IF
401  ip = ip + jinc*jlen
402  jlen = jlen - 1
403  30 CONTINUE
404  grow = xbnd
405  ELSE
406 *
407 * A is unit triangular.
408 *
409 * Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
410 *
411  grow = min( one, one / max( xbnd, smlnum ) )
412  DO 40 j = jfirst, jlast, jinc
413 *
414 * Exit the loop if the growth factor is too small.
415 *
416  IF( grow.LE.smlnum )
417  $ GO TO 50
418 *
419 * G(j) = G(j-1)*( 1 + CNORM(j) )
420 *
421  grow = grow*( one / ( one+cnorm( j ) ) )
422  40 CONTINUE
423  END IF
424  50 CONTINUE
425 *
426  ELSE
427 *
428 * Compute the growth in A**T * x = b.
429 *
430  IF( upper ) THEN
431  jfirst = 1
432  jlast = n
433  jinc = 1
434  ELSE
435  jfirst = n
436  jlast = 1
437  jinc = -1
438  END IF
439 *
440  IF( tscal.NE.one ) THEN
441  grow = zero
442  GO TO 80
443  END IF
444 *
445  IF( nounit ) THEN
446 *
447 * A is non-unit triangular.
448 *
449 * Compute GROW = 1/G(j) and XBND = 1/M(j).
450 * Initially, M(0) = max{x(i), i=1,...,n}.
451 *
452  grow = one / max( xbnd, smlnum )
453  xbnd = grow
454  ip = jfirst*( jfirst+1 ) / 2
455  jlen = 1
456  DO 60 j = jfirst, jlast, jinc
457 *
458 * Exit the loop if the growth factor is too small.
459 *
460  IF( grow.LE.smlnum )
461  $ GO TO 80
462 *
463 * G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
464 *
465  xj = one + cnorm( j )
466  grow = min( grow, xbnd / xj )
467 *
468 * M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
469 *
470  tjj = abs( ap( ip ) )
471  IF( xj.GT.tjj )
472  $ xbnd = xbnd*( tjj / xj )
473  jlen = jlen + 1
474  ip = ip + jinc*jlen
475  60 CONTINUE
476  grow = min( grow, xbnd )
477  ELSE
478 *
479 * A is unit triangular.
480 *
481 * Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
482 *
483  grow = min( one, one / max( xbnd, smlnum ) )
484  DO 70 j = jfirst, jlast, jinc
485 *
486 * Exit the loop if the growth factor is too small.
487 *
488  IF( grow.LE.smlnum )
489  $ GO TO 80
490 *
491 * G(j) = ( 1 + CNORM(j) )*G(j-1)
492 *
493  xj = one + cnorm( j )
494  grow = grow / xj
495  70 CONTINUE
496  END IF
497  80 CONTINUE
498  END IF
499 *
500  IF( ( grow*tscal ).GT.smlnum ) THEN
501 *
502 * Use the Level 2 BLAS solve if the reciprocal of the bound on
503 * elements of X is not too small.
504 *
505  CALL stpsv( uplo, trans, diag, n, ap, x, 1 )
506  ELSE
507 *
508 * Use a Level 1 BLAS solve, scaling intermediate results.
509 *
510  IF( xmax.GT.bignum ) THEN
511 *
512 * Scale X so that its components are less than or equal to
513 * BIGNUM in absolute value.
514 *
515  scale = bignum / xmax
516  CALL sscal( n, scale, x, 1 )
517  xmax = bignum
518  END IF
519 *
520  IF( notran ) THEN
521 *
522 * Solve A * x = b
523 *
524  ip = jfirst*( jfirst+1 ) / 2
525  DO 100 j = jfirst, jlast, jinc
526 *
527 * Compute x(j) = b(j) / A(j,j), scaling x if necessary.
528 *
529  xj = abs( x( j ) )
530  IF( nounit ) THEN
531  tjjs = ap( ip )*tscal
532  ELSE
533  tjjs = tscal
534  IF( tscal.EQ.one )
535  $ GO TO 95
536  END IF
537  tjj = abs( tjjs )
538  IF( tjj.GT.smlnum ) THEN
539 *
540 * abs(A(j,j)) > SMLNUM:
541 *
542  IF( tjj.LT.one ) THEN
543  IF( xj.GT.tjj*bignum ) THEN
544 *
545 * Scale x by 1/b(j).
546 *
547  rec = one / xj
548  CALL sscal( n, rec, x, 1 )
549  scale = scale*rec
550  xmax = xmax*rec
551  END IF
552  END IF
553  x( j ) = x( j ) / tjjs
554  xj = abs( x( j ) )
555  ELSE IF( tjj.GT.zero ) THEN
556 *
557 * 0 < abs(A(j,j)) <= SMLNUM:
558 *
559  IF( xj.GT.tjj*bignum ) THEN
560 *
561 * Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
562 * to avoid overflow when dividing by A(j,j).
563 *
564  rec = ( tjj*bignum ) / xj
565  IF( cnorm( j ).GT.one ) THEN
566 *
567 * Scale by 1/CNORM(j) to avoid overflow when
568 * multiplying x(j) times column j.
569 *
570  rec = rec / cnorm( j )
571  END IF
572  CALL sscal( n, rec, x, 1 )
573  scale = scale*rec
574  xmax = xmax*rec
575  END IF
576  x( j ) = x( j ) / tjjs
577  xj = abs( x( j ) )
578  ELSE
579 *
580 * A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
581 * scale = 0, and compute a solution to A*x = 0.
582 *
583  DO 90 i = 1, n
584  x( i ) = zero
585  90 CONTINUE
586  x( j ) = one
587  xj = one
588  scale = zero
589  xmax = zero
590  END IF
591  95 CONTINUE
592 *
593 * Scale x if necessary to avoid overflow when adding a
594 * multiple of column j of A.
595 *
596  IF( xj.GT.one ) THEN
597  rec = one / xj
598  IF( cnorm( j ).GT.( bignum-xmax )*rec ) THEN
599 *
600 * Scale x by 1/(2*abs(x(j))).
601 *
602  rec = rec*half
603  CALL sscal( n, rec, x, 1 )
604  scale = scale*rec
605  END IF
606  ELSE IF( xj*cnorm( j ).GT.( bignum-xmax ) ) THEN
607 *
608 * Scale x by 1/2.
609 *
610  CALL sscal( n, half, x, 1 )
611  scale = scale*half
612  END IF
613 *
614  IF( upper ) THEN
615  IF( j.GT.1 ) THEN
616 *
617 * Compute the update
618 * x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
619 *
620  CALL saxpy( j-1, -x( j )*tscal, ap( ip-j+1 ), 1, x,
621  $ 1 )
622  i = isamax( j-1, x, 1 )
623  xmax = abs( x( i ) )
624  END IF
625  ip = ip - j
626  ELSE
627  IF( j.LT.n ) THEN
628 *
629 * Compute the update
630 * x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
631 *
632  CALL saxpy( n-j, -x( j )*tscal, ap( ip+1 ), 1,
633  $ x( j+1 ), 1 )
634  i = j + isamax( n-j, x( j+1 ), 1 )
635  xmax = abs( x( i ) )
636  END IF
637  ip = ip + n - j + 1
638  END IF
639  100 CONTINUE
640 *
641  ELSE
642 *
643 * Solve A**T * x = b
644 *
645  ip = jfirst*( jfirst+1 ) / 2
646  jlen = 1
647  DO 140 j = jfirst, jlast, jinc
648 *
649 * Compute x(j) = b(j) - sum A(k,j)*x(k).
650 * k<>j
651 *
652  xj = abs( x( j ) )
653  uscal = tscal
654  rec = one / max( xmax, one )
655  IF( cnorm( j ).GT.( bignum-xj )*rec ) THEN
656 *
657 * If x(j) could overflow, scale x by 1/(2*XMAX).
658 *
659  rec = rec*half
660  IF( nounit ) THEN
661  tjjs = ap( ip )*tscal
662  ELSE
663  tjjs = tscal
664  END IF
665  tjj = abs( tjjs )
666  IF( tjj.GT.one ) THEN
667 *
668 * Divide by A(j,j) when scaling x if A(j,j) > 1.
669 *
670  rec = min( one, rec*tjj )
671  uscal = uscal / tjjs
672  END IF
673  IF( rec.LT.one ) THEN
674  CALL sscal( n, rec, x, 1 )
675  scale = scale*rec
676  xmax = xmax*rec
677  END IF
678  END IF
679 *
680  sumj = zero
681  IF( uscal.EQ.one ) THEN
682 *
683 * If the scaling needed for A in the dot product is 1,
684 * call SDOT to perform the dot product.
685 *
686  IF( upper ) THEN
687  sumj = sdot( j-1, ap( ip-j+1 ), 1, x, 1 )
688  ELSE IF( j.LT.n ) THEN
689  sumj = sdot( n-j, ap( ip+1 ), 1, x( j+1 ), 1 )
690  END IF
691  ELSE
692 *
693 * Otherwise, use in-line code for the dot product.
694 *
695  IF( upper ) THEN
696  DO 110 i = 1, j - 1
697  sumj = sumj + ( ap( ip-j+i )*uscal )*x( i )
698  110 CONTINUE
699  ELSE IF( j.LT.n ) THEN
700  DO 120 i = 1, n - j
701  sumj = sumj + ( ap( ip+i )*uscal )*x( j+i )
702  120 CONTINUE
703  END IF
704  END IF
705 *
706  IF( uscal.EQ.tscal ) THEN
707 *
708 * Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
709 * was not used to scale the dotproduct.
710 *
711  x( j ) = x( j ) - sumj
712  xj = abs( x( j ) )
713  IF( nounit ) THEN
714 *
715 * Compute x(j) = x(j) / A(j,j), scaling if necessary.
716 *
717  tjjs = ap( ip )*tscal
718  ELSE
719  tjjs = tscal
720  IF( tscal.EQ.one )
721  $ GO TO 135
722  END IF
723  tjj = abs( tjjs )
724  IF( tjj.GT.smlnum ) THEN
725 *
726 * abs(A(j,j)) > SMLNUM:
727 *
728  IF( tjj.LT.one ) THEN
729  IF( xj.GT.tjj*bignum ) THEN
730 *
731 * Scale X by 1/abs(x(j)).
732 *
733  rec = one / xj
734  CALL sscal( n, rec, x, 1 )
735  scale = scale*rec
736  xmax = xmax*rec
737  END IF
738  END IF
739  x( j ) = x( j ) / tjjs
740  ELSE IF( tjj.GT.zero ) THEN
741 *
742 * 0 < abs(A(j,j)) <= SMLNUM:
743 *
744  IF( xj.GT.tjj*bignum ) THEN
745 *
746 * Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
747 *
748  rec = ( tjj*bignum ) / xj
749  CALL sscal( n, rec, x, 1 )
750  scale = scale*rec
751  xmax = xmax*rec
752  END IF
753  x( j ) = x( j ) / tjjs
754  ELSE
755 *
756 * A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
757 * scale = 0, and compute a solution to A**T*x = 0.
758 *
759  DO 130 i = 1, n
760  x( i ) = zero
761  130 CONTINUE
762  x( j ) = one
763  scale = zero
764  xmax = zero
765  END IF
766  135 CONTINUE
767  ELSE
768 *
769 * Compute x(j) := x(j) / A(j,j) - sumj if the dot
770 * product has already been divided by 1/A(j,j).
771 *
772  x( j ) = x( j ) / tjjs - sumj
773  END IF
774  xmax = max( xmax, abs( x( j ) ) )
775  jlen = jlen + 1
776  ip = ip + jinc*jlen
777  140 CONTINUE
778  END IF
779  scale = scale / tscal
780  END IF
781 *
782 * Scale the column norms by 1/TSCAL for return.
783 *
784  IF( tscal.NE.one ) THEN
785  CALL sscal( n, one / tscal, cnorm, 1 )
786  END IF
787 *
788  RETURN
789 *
790 * End of SLATPS
791 *
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:71
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:79
real function sdot(N, SX, INCX, SY, INCY)
SDOT
Definition: sdot.f:82
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
Definition: saxpy.f:89
real function sasum(N, SX, INCX)
SASUM
Definition: sasum.f:72
subroutine stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPSV
Definition: stpsv.f:144
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: