File:  [local] / rpl / lapack / lapack / dlat2s.f
Revision 1.4: download - view: text, annotated - select for diffs - revision graph
Tue Dec 21 13:53:34 2010 UTC (13 years, 4 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_0, rpl-4_0_24, rpl-4_0_22, rpl-4_0_21, rpl-4_0_20, rpl-4_0, HEAD
Mise à jour de lapack vers la version 3.3.0.

    1:       SUBROUTINE DLAT2S( UPLO, N, A, LDA, SA, LDSA, INFO )
    2: *
    3: *  -- LAPACK PROTOTYPE auxiliary routine (version 3.1.2) --
    4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    6: *     May 2007
    7: *
    8: *     .. Scalar Arguments ..
    9:       CHARACTER          UPLO
   10:       INTEGER            INFO, LDA, LDSA, N
   11: *     ..
   12: *     .. Array Arguments ..
   13:       REAL               SA( LDSA, * )
   14:       DOUBLE PRECISION   A( LDA, * )
   15: *     ..
   16: *
   17: *  Purpose
   18: *  =======
   19: *
   20: *  DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE
   21: *  PRECISION triangular matrix, A.
   22: *
   23: *  RMAX is the overflow for the SINGLE PRECISION arithmetic
   24: *  DLAS2S checks that all the entries of A are between -RMAX and
   25: *  RMAX. If not the convertion is aborted and a flag is raised.
   26: *
   27: *  This is an auxiliary routine so there is no argument checking.
   28: *
   29: *  Arguments
   30: *  =========
   31: *
   32: *  UPLO    (input) CHARACTER*1
   33: *          = 'U':  A is upper triangular;
   34: *          = 'L':  A is lower triangular.
   35: *
   36: *  N       (input) INTEGER
   37: *          The number of rows and columns of the matrix A.  N >= 0.
   38: *
   39: *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
   40: *          On entry, the N-by-N triangular coefficient matrix A.
   41: *
   42: *  LDA     (input) INTEGER
   43: *          The leading dimension of the array A.  LDA >= max(1,N).
   44: *
   45: *  SA      (output) REAL array, dimension (LDSA,N)
   46: *          Only the UPLO part of SA is referenced.  On exit, if INFO=0,
   47: *          the N-by-N coefficient matrix SA; if INFO>0, the content of
   48: *          the UPLO part of SA is unspecified.
   49: *
   50: *  LDSA    (input) INTEGER
   51: *          The leading dimension of the array SA.  LDSA >= max(1,M).
   52: *
   53: *  INFO    (output) INTEGER
   54: *          = 0:  successful exit.
   55: *          = 1:  an entry of the matrix A is greater than the SINGLE
   56: *                PRECISION overflow threshold, in this case, the content
   57: *                of the UPLO part of SA in exit is unspecified.
   58: *
   59: *  =========
   60: *
   61: *     .. Local Scalars ..
   62:       INTEGER            I, J
   63:       DOUBLE PRECISION   RMAX
   64:       LOGICAL            UPPER
   65: *     ..
   66: *     .. External Functions ..
   67:       REAL               SLAMCH
   68:       LOGICAL            LSAME
   69:       EXTERNAL           SLAMCH, LSAME
   70: *     ..
   71: *     .. Executable Statements ..
   72: *
   73:       RMAX = SLAMCH( 'O' )
   74:       UPPER = LSAME( UPLO, 'U' )
   75:       IF( UPPER ) THEN
   76:          DO 20 J = 1, N
   77:             DO 10 I = 1, J
   78:                IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
   79:      +             THEN
   80:                   INFO = 1
   81:                   GO TO 50
   82:                END IF
   83:                SA( I, J ) = A( I, J )
   84:    10       CONTINUE
   85:    20    CONTINUE
   86:       ELSE
   87:          DO 40 J = 1, N
   88:             DO 30 I = J, N
   89:                IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) )
   90:      +             THEN
   91:                   INFO = 1
   92:                   GO TO 50
   93:                END IF
   94:                SA( I, J ) = A( I, J )
   95:    30       CONTINUE
   96:    40    CONTINUE
   97:       END IF
   98:    50 CONTINUE
   99: *
  100:       RETURN
  101: *
  102: *     End of DLAT2S
  103: *
  104:       END

CVSweb interface <joel.bertrand@systella.fr>