dc/d32/sget10_8f_source.html

00001       SUBROUTINE SGET10( M, N, A, LDA, B, LDB, WORK, 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               A( LDA, * ), B( LDB, * ), WORK( * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  SGET10 compares two matrices A and B and computes the ratio
00019 *  RESULT = norm( A - B ) / ( norm(A) * M * EPS )
00020 *
00021 *  Arguments
00022 *  =========
00023 *
00024 *  M       (input) INTEGER
00025 *          The number of rows of the matrices A and B.
00026 *
00027 *  N       (input) INTEGER
00028 *          The number of columns of the matrices A and B.
00029 *
00030 *  A       (input) REAL array, dimension (LDA,N)
00031 *          The m by n matrix A.
00032 *
00033 *  LDA     (input) INTEGER
00034 *          The leading dimension of the array A.  LDA >= max(1,M).
00035 *
00036 *  B       (input) REAL array, dimension (LDB,N)
00037 *          The m by n matrix B.
00038 *
00039 *  LDB     (input) INTEGER
00040 *          The leading dimension of the array B.  LDB >= max(1,M).
00041 *
00042 *  WORK    (workspace) REAL array, dimension (M)
00043 *
00044 *  RESULT  (output) REAL
00045 *          RESULT = norm( A - B ) / ( norm(A) * M * EPS )
00046 *
00047 *  =====================================================================
00048 *
00049 *     .. Parameters ..
00050       REAL               ONE, ZERO
00051       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00052 *     ..
00053 *     .. Local Scalars ..
00054       INTEGER            J
00055       REAL               ANORM, EPS, UNFL, WNORM
00056 *     ..
00057 *     .. External Functions ..
00058       REAL               SASUM, SLAMCH, SLANGE
00059       EXTERNAL           SASUM, SLAMCH, SLANGE
00060 *     ..
00061 *     .. External Subroutines ..
00062       EXTERNAL           SAXPY, SCOPY
00063 *     ..
00064 *     .. Intrinsic Functions ..
00065       INTRINSIC          MAX, MIN, REAL
00066 *     ..
00067 *     .. Executable Statements ..
00068 *
00069 *     Quick return if possible
00070 *
00071       IF( M.LE.0 .OR. N.LE.0 ) THEN
00072          RESULT = ZERO
00073          RETURN
00074       END IF
00075 *
00076       UNFL = SLAMCH( 'Safe minimum' )
00077       EPS = SLAMCH( 'Precision' )
00078 *
00079       WNORM = ZERO
00080       DO 10 J = 1, N
00081          CALL SCOPY( M, A( 1, J ), 1, WORK, 1 )
00082          CALL SAXPY( M, -ONE, B( 1, J ), 1, WORK, 1 )
00083          WNORM = MAX( WNORM, SASUM( N, WORK, 1 ) )
00084    10 CONTINUE
00085 *
00086       ANORM = MAX( SLANGE( '1', M, N, A, LDA, WORK ), UNFL )
00087 *
00088       IF( ANORM.GT.WNORM ) THEN
00089          RESULT = ( WNORM / ANORM ) / ( M*EPS )
00090       ELSE
00091          IF( ANORM.LT.ONE ) THEN
00092             RESULT = ( MIN( WNORM, M*ANORM ) / ANORM ) / ( M*EPS )
00093          ELSE
00094             RESULT = MIN( WNORM / ANORM, REAL( M ) ) / ( M*EPS )
00095          END IF
00096       END IF
00097 *
00098       RETURN
00099 *
00100 *     End of SGET10
00101 *
00102       END