LAPACK: TESTING/LIN/cget01.f Source File

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