![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SGET10 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SGET10( M, N, A, LDA, B, LDB, WORK, RESULT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER LDA, LDB, M, N 00015 * REAL RESULT 00016 * .. 00017 * .. Array Arguments .. 00018 * REAL A( LDA, * ), B( LDB, * ), WORK( * ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> SGET10 compares two matrices A and B and computes the ratio 00028 *> RESULT = norm( A - B ) / ( norm(A) * M * EPS ) 00029 *> \endverbatim 00030 * 00031 * Arguments: 00032 * ========== 00033 * 00034 *> \param[in] M 00035 *> \verbatim 00036 *> M is INTEGER 00037 *> The number of rows of the matrices A and B. 00038 *> \endverbatim 00039 *> 00040 *> \param[in] N 00041 *> \verbatim 00042 *> N is INTEGER 00043 *> The number of columns of the matrices A and B. 00044 *> \endverbatim 00045 *> 00046 *> \param[in] A 00047 *> \verbatim 00048 *> A is REAL array, dimension (LDA,N) 00049 *> The m by n matrix A. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] LDA 00053 *> \verbatim 00054 *> LDA is INTEGER 00055 *> The leading dimension of the array A. LDA >= max(1,M). 00056 *> \endverbatim 00057 *> 00058 *> \param[in] B 00059 *> \verbatim 00060 *> B is REAL array, dimension (LDB,N) 00061 *> The m by n matrix B. 00062 *> \endverbatim 00063 *> 00064 *> \param[in] LDB 00065 *> \verbatim 00066 *> LDB is INTEGER 00067 *> The leading dimension of the array B. LDB >= max(1,M). 00068 *> \endverbatim 00069 *> 00070 *> \param[out] WORK 00071 *> \verbatim 00072 *> WORK is REAL array, dimension (M) 00073 *> \endverbatim 00074 *> 00075 *> \param[out] RESULT 00076 *> \verbatim 00077 *> RESULT is REAL 00078 *> RESULT = norm( A - B ) / ( norm(A) * M * EPS ) 00079 *> \endverbatim 00080 * 00081 * Authors: 00082 * ======== 00083 * 00084 *> \author Univ. of Tennessee 00085 *> \author Univ. of California Berkeley 00086 *> \author Univ. of Colorado Denver 00087 *> \author NAG Ltd. 00088 * 00089 *> \date November 2011 00090 * 00091 *> \ingroup single_eig 00092 * 00093 * ===================================================================== 00094 SUBROUTINE SGET10( M, N, A, LDA, B, LDB, WORK, RESULT ) 00095 * 00096 * -- LAPACK test routine (version 3.4.0) -- 00097 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00098 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00099 * November 2011 00100 * 00101 * .. Scalar Arguments .. 00102 INTEGER LDA, LDB, M, N 00103 REAL RESULT 00104 * .. 00105 * .. Array Arguments .. 00106 REAL A( LDA, * ), B( LDB, * ), WORK( * ) 00107 * .. 00108 * 00109 * ===================================================================== 00110 * 00111 * .. Parameters .. 00112 REAL ONE, ZERO 00113 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00114 * .. 00115 * .. Local Scalars .. 00116 INTEGER J 00117 REAL ANORM, EPS, UNFL, WNORM 00118 * .. 00119 * .. External Functions .. 00120 REAL SASUM, SLAMCH, SLANGE 00121 EXTERNAL SASUM, SLAMCH, SLANGE 00122 * .. 00123 * .. External Subroutines .. 00124 EXTERNAL SAXPY, SCOPY 00125 * .. 00126 * .. Intrinsic Functions .. 00127 INTRINSIC MAX, MIN, REAL 00128 * .. 00129 * .. Executable Statements .. 00130 * 00131 * Quick return if possible 00132 * 00133 IF( M.LE.0 .OR. N.LE.0 ) THEN 00134 RESULT = ZERO 00135 RETURN 00136 END IF 00137 * 00138 UNFL = SLAMCH( 'Safe minimum' ) 00139 EPS = SLAMCH( 'Precision' ) 00140 * 00141 WNORM = ZERO 00142 DO 10 J = 1, N 00143 CALL SCOPY( M, A( 1, J ), 1, WORK, 1 ) 00144 CALL SAXPY( M, -ONE, B( 1, J ), 1, WORK, 1 ) 00145 WNORM = MAX( WNORM, SASUM( N, WORK, 1 ) ) 00146 10 CONTINUE 00147 * 00148 ANORM = MAX( SLANGE( '1', M, N, A, LDA, WORK ), UNFL ) 00149 * 00150 IF( ANORM.GT.WNORM ) THEN 00151 RESULT = ( WNORM / ANORM ) / ( M*EPS ) 00152 ELSE 00153 IF( ANORM.LT.ONE ) THEN 00154 RESULT = ( MIN( WNORM, M*ANORM ) / ANORM ) / ( M*EPS ) 00155 ELSE 00156 RESULT = MIN( WNORM / ANORM, REAL( M ) ) / ( M*EPS ) 00157 END IF 00158 END IF 00159 * 00160 RETURN 00161 * 00162 * End of SGET10 00163 * 00164 END