d3/d68/cget10_8f_source.html

00001       SUBROUTINE CGET10( M, N, A, LDA, B, LDB, WORK, RWORK, RESULT )
00002 *
00003 *  -- LAPACK test routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            LDA, LDB, M, N
00009       REAL               RESULT
00010 *     ..
00011 *     .. Array Arguments ..
00012       REAL               RWORK( * )
00013       COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  CGET10 compares two matrices A and B and computes the ratio
00020 *  RESULT = norm( A - B ) / ( norm(A) * M * EPS )
00021 *
00022 *  Arguments
00023 *  =========
00024 *
00025 *  M       (input) INTEGER
00026 *          The number of rows of the matrices A and B.
00027 *
00028 *  N       (input) INTEGER
00029 *          The number of columns of the matrices A and B.
00030 *
00031 *  A       (input) COMPLEX array, dimension (LDA,N)
00032 *          The m by n matrix A.
00033 *
00034 *  LDA     (input) INTEGER
00035 *          The leading dimension of the array A.  LDA >= max(1,M).
00036 *
00037 *  B       (input) COMPLEX array, dimension (LDB,N)
00038 *          The m by n matrix B.
00039 *
00040 *  LDB     (input) INTEGER
00041 *          The leading dimension of the array B.  LDB >= max(1,M).
00042 *
00043 *  WORK    (workspace) COMPLEX array, dimension (M)
00044 *
00045 *  RWORK   (workspace) COMPLEX array, dimension (M)
00046 *
00047 *  RESULT  (output) REAL
00048 *          RESULT = norm( A - B ) / ( norm(A) * M * EPS )
00049 *
00050 *  =====================================================================
00051 *
00052 *     .. Parameters ..
00053       REAL               ONE, ZERO
00054       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00055 *     ..
00056 *     .. Local Scalars ..
00057       INTEGER            J
00058       REAL               ANORM, EPS, UNFL, WNORM
00059 *     ..
00060 *     .. External Functions ..
00061       REAL               SCASUM, SLAMCH, CLANGE
00062       EXTERNAL           SCASUM, SLAMCH, CLANGE
00063 *     ..
00064 *     .. External Subroutines ..
00065       EXTERNAL           CAXPY, CCOPY
00066 *     ..
00067 *     .. Intrinsic Functions ..
00068       INTRINSIC          MAX, MIN, REAL
00069 *     ..
00070 *     .. Executable Statements ..
00071 *
00072 *     Quick return if possible
00073 *
00074       IF( M.LE.0 .OR. N.LE.0 ) THEN
00075          RESULT = ZERO
00076          RETURN
00077       END IF
00078 *
00079       UNFL = SLAMCH( 'Safe minimum' )
00080       EPS = SLAMCH( 'Precision' )
00081 *
00082       WNORM = ZERO
00083       DO 10 J = 1, N
00084          CALL CCOPY( M, A( 1, J ), 1, WORK, 1 )
00085          CALL CAXPY( M, CMPLX( -ONE ), B( 1, J ), 1, WORK, 1 )
00086          WNORM = MAX( WNORM, SCASUM( N, WORK, 1 ) )
00087    10 CONTINUE
00088 *
00089       ANORM = MAX( CLANGE( '1', M, N, A, LDA, RWORK ), UNFL )
00090 *
00091       IF( ANORM.GT.WNORM ) THEN
00092          RESULT = ( WNORM / ANORM ) / ( M*EPS )
00093       ELSE
00094          IF( ANORM.LT.ONE ) THEN
00095             RESULT = ( MIN( WNORM, M*ANORM ) / ANORM ) / ( M*EPS )
00096          ELSE
00097             RESULT = MIN( WNORM / ANORM, REAL( M ) ) / ( M*EPS )
00098          END IF
00099       END IF
00100 *
00101       RETURN
00102 *
00103 *     End of CGET10
00104 *
00105       END