LAPACK: TESTING/LIN/sget01.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SGET01( M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK,
00002      $                   RESID )
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            LDA, LDAFAC, M, N
00010       REAL               RESID
00011 *     ..
00012 *     .. Array Arguments ..
00013       INTEGER            IPIV( * )
00014       REAL               A( LDA, * ), AFAC( LDAFAC, * ), RWORK( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  SGET01 reconstructs a matrix A from its L*U factorization and
00021 *  computes the residual
00022 *     norm(L*U - A) / ( N * norm(A) * EPS ),
00023 *  where EPS is the machine epsilon.
00024 *
00025 *  Arguments
00026 *  ==========
00027 *
00028 *  M       (input) INTEGER
00029 *          The number of rows of the matrix A.  M >= 0.
00030 *
00031 *  N       (input) INTEGER
00032 *          The number of columns of the matrix A.  N >= 0.
00033 *
00034 *  A       (input) REAL array, dimension (LDA,N)
00035 *          The original M x N matrix A.
00036 *
00037 *  LDA     (input) INTEGER
00038 *          The leading dimension of the array A.  LDA >= max(1,M).
00039 *
00040 *  AFAC    (input/output) REAL array, dimension (LDAFAC,N)
00041 *          The factored form of the matrix A.  AFAC contains the factors
00042 *          L and U from the L*U factorization as computed by SGETRF.
00043 *          Overwritten with the reconstructed matrix, and then with the
00044 *          difference L*U - A.
00045 *
00046 *  LDAFAC  (input) INTEGER
00047 *          The leading dimension of the array AFAC.  LDAFAC >= max(1,M).
00048 *
00049 *  IPIV    (input) INTEGER array, dimension (N)
00050 *          The pivot indices from SGETRF.
00051 *
00052 *  RWORK   (workspace) REAL array, dimension (M)
00053 *
00054 *  RESID   (output) REAL
00055 *          norm(L*U - A) / ( N * norm(A) * EPS )
00056 *
00057 *  =====================================================================
00058 *
00059 *
00060 *     .. Parameters ..
00061       REAL               ZERO, ONE
00062       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00063 *     ..
00064 *     .. Local Scalars ..
00065       INTEGER            I, J, K
00066       REAL               ANORM, EPS, T
00067 *     ..
00068 *     .. External Functions ..
00069       REAL               SDOT, SLAMCH, SLANGE
00070       EXTERNAL           SDOT, SLAMCH, SLANGE
00071 *     ..
00072 *     .. External Subroutines ..
00073       EXTERNAL           SGEMV, SLASWP, SSCAL, STRMV
00074 *     ..
00075 *     .. Intrinsic Functions ..
00076       INTRINSIC          MIN, REAL
00077 *     ..
00078 *     .. Executable Statements ..
00079 *
00080 *     Quick exit if M = 0 or N = 0.
00081 *
00082       IF( M.LE.0 .OR. N.LE.0 ) THEN
00083          RESID = ZERO
00084          RETURN
00085       END IF
00086 *
00087 *     Determine EPS and the norm of A.
00088 *
00089       EPS = SLAMCH( 'Epsilon' )
00090       ANORM = SLANGE( '1', M, N, A, LDA, RWORK )
00091 *
00092 *     Compute the product L*U and overwrite AFAC with the result.
00093 *     A column at a time of the product is obtained, starting with
00094 *     column N.
00095 *
00096       DO 10 K = N, 1, -1
00097          IF( K.GT.M ) THEN
00098             CALL STRMV( 'Lower', 'No transpose', 'Unit', M, AFAC,
00099      $                  LDAFAC, AFAC( 1, K ), 1 )
00100          ELSE
00101 *
00102 *           Compute elements (K+1:M,K)
00103 *
00104             T = AFAC( K, K )
00105             IF( K+1.LE.M ) THEN
00106                CALL SSCAL( M-K, T, AFAC( K+1, K ), 1 )
00107                CALL SGEMV( 'No transpose', M-K, K-1, ONE,
00108      $                     AFAC( K+1, 1 ), LDAFAC, AFAC( 1, K ), 1, ONE,
00109      $                     AFAC( K+1, K ), 1 )
00110             END IF
00111 *
00112 *           Compute the (K,K) element
00113 *
00114             AFAC( K, K ) = T + SDOT( K-1, AFAC( K, 1 ), LDAFAC,
00115      $                     AFAC( 1, K ), 1 )
00116 *
00117 *           Compute elements (1:K-1,K)
00118 *
00119             CALL STRMV( 'Lower', 'No transpose', 'Unit', K-1, AFAC,
00120      $                  LDAFAC, AFAC( 1, K ), 1 )
00121          END IF
00122    10 CONTINUE
00123       CALL SLASWP( N, AFAC, LDAFAC, 1, MIN( M, N ), IPIV, -1 )
00124 *
00125 *     Compute the difference  L*U - A  and store in AFAC.
00126 *
00127       DO 30 J = 1, N
00128          DO 20 I = 1, M
00129             AFAC( I, J ) = AFAC( I, J ) - A( I, J )
00130    20    CONTINUE
00131    30 CONTINUE
00132 *
00133 *     Compute norm( L*U - A ) / ( N * norm(A) * EPS )
00134 *
00135       RESID = SLANGE( '1', M, N, AFAC, LDAFAC, RWORK )
00136 *
00137       IF( ANORM.LE.ZERO ) THEN
00138          IF( RESID.NE.ZERO )
00139      $      RESID = ONE / EPS
00140       ELSE
00141          RESID = ( ( RESID / REAL( N ) ) / ANORM ) / EPS
00142       END IF
00143 *
00144       RETURN
00145 *
00146 *     End of SGET01
00147 *
00148       END