![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAFTS 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 SLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, 00012 * THRESH, IOUNIT, IE ) 00013 * 00014 * .. Scalar Arguments .. 00015 * CHARACTER*3 TYPE 00016 * INTEGER IE, IMAT, IOUNIT, M, N, NTESTS 00017 * REAL THRESH 00018 * .. 00019 * .. Array Arguments .. 00020 * INTEGER ISEED( 4 ) 00021 * REAL RESULT( * ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> SLAFTS tests the result vector against the threshold value to 00031 *> see which tests for this matrix type failed to pass the threshold. 00032 *> Output is to the file given by unit IOUNIT. 00033 *> \endverbatim 00034 * 00035 * Arguments: 00036 * ========== 00037 * 00038 *> \verbatim 00039 *> TYPE - CHARACTER*3 00040 *> On entry, TYPE specifies the matrix type to be used in the 00041 *> printed messages. 00042 *> Not modified. 00043 *> 00044 *> N - INTEGER 00045 *> On entry, N specifies the order of the test matrix. 00046 *> Not modified. 00047 *> 00048 *> IMAT - INTEGER 00049 *> On entry, IMAT specifies the type of the test matrix. 00050 *> A listing of the different types is printed by SLAHD2 00051 *> to the output file if a test fails to pass the threshold. 00052 *> Not modified. 00053 *> 00054 *> NTESTS - INTEGER 00055 *> On entry, NTESTS is the number of tests performed on the 00056 *> subroutines in the path given by TYPE. 00057 *> Not modified. 00058 *> 00059 *> RESULT - REAL array of dimension( NTESTS ) 00060 *> On entry, RESULT contains the test ratios from the tests 00061 *> performed in the calling program. 00062 *> Not modified. 00063 *> 00064 *> ISEED - INTEGER array of dimension( 4 ) 00065 *> Contains the random seed that generated the matrix used 00066 *> for the tests whose ratios are in RESULT. 00067 *> Not modified. 00068 *> 00069 *> THRESH - REAL 00070 *> On entry, THRESH specifies the acceptable threshold of the 00071 *> test ratios. If RESULT( K ) > THRESH, then the K-th test 00072 *> did not pass the threshold and a message will be printed. 00073 *> Not modified. 00074 *> 00075 *> IOUNIT - INTEGER 00076 *> On entry, IOUNIT specifies the unit number of the file 00077 *> to which the messages are printed. 00078 *> Not modified. 00079 *> 00080 *> IE - INTEGER 00081 *> On entry, IE contains the number of tests which have 00082 *> failed to pass the threshold so far. 00083 *> Updated on exit if any of the ratios in RESULT also fail. 00084 *> \endverbatim 00085 * 00086 * Authors: 00087 * ======== 00088 * 00089 *> \author Univ. of Tennessee 00090 *> \author Univ. of California Berkeley 00091 *> \author Univ. of Colorado Denver 00092 *> \author NAG Ltd. 00093 * 00094 *> \date November 2011 00095 * 00096 *> \ingroup single_eig 00097 * 00098 * ===================================================================== 00099 SUBROUTINE SLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, 00100 $ THRESH, IOUNIT, IE ) 00101 * 00102 * -- LAPACK test routine (version 3.4.0) -- 00103 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00104 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00105 * November 2011 00106 * 00107 * .. Scalar Arguments .. 00108 CHARACTER*3 TYPE 00109 INTEGER IE, IMAT, IOUNIT, M, N, NTESTS 00110 REAL THRESH 00111 * .. 00112 * .. Array Arguments .. 00113 INTEGER ISEED( 4 ) 00114 REAL RESULT( * ) 00115 * .. 00116 * 00117 * ===================================================================== 00118 * 00119 * .. Local Scalars .. 00120 INTEGER K 00121 * .. 00122 * .. External Subroutines .. 00123 EXTERNAL SLAHD2 00124 * .. 00125 * .. Executable Statements .. 00126 * 00127 IF( M.EQ.N ) THEN 00128 * 00129 * Output for square matrices: 00130 * 00131 DO 10 K = 1, NTESTS 00132 IF( RESULT( K ).GE.THRESH ) THEN 00133 * 00134 * If this is the first test to fail, call SLAHD2 00135 * to print a header to the data file. 00136 * 00137 IF( IE.EQ.0 ) 00138 $ CALL SLAHD2( IOUNIT, TYPE ) 00139 IE = IE + 1 00140 IF( RESULT( K ).LT.10000.0 ) THEN 00141 WRITE( IOUNIT, FMT = 9999 )N, IMAT, ISEED, K, 00142 $ RESULT( K ) 00143 9999 FORMAT( ' Matrix order=', I5, ', type=', I2, 00144 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is', 00145 $ 0P, F8.2 ) 00146 ELSE 00147 WRITE( IOUNIT, FMT = 9998 )N, IMAT, ISEED, K, 00148 $ RESULT( K ) 00149 9998 FORMAT( ' Matrix order=', I5, ', type=', I2, 00150 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is', 00151 $ 1P, E10.3 ) 00152 END IF 00153 END IF 00154 10 CONTINUE 00155 ELSE 00156 * 00157 * Output for rectangular matrices 00158 * 00159 DO 20 K = 1, NTESTS 00160 IF( RESULT( K ).GE.THRESH ) THEN 00161 * 00162 * If this is the first test to fail, call SLAHD2 00163 * to print a header to the data file. 00164 * 00165 IF( IE.EQ.0 ) 00166 $ CALL SLAHD2( IOUNIT, TYPE ) 00167 IE = IE + 1 00168 IF( RESULT( K ).LT.10000.0 ) THEN 00169 WRITE( IOUNIT, FMT = 9997 )M, N, IMAT, ISEED, K, 00170 $ RESULT( K ) 00171 9997 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s', 00172 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3, 00173 $ ' is', 0P, F8.2 ) 00174 ELSE 00175 WRITE( IOUNIT, FMT = 9996 )M, N, IMAT, ISEED, K, 00176 $ RESULT( K ) 00177 9996 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s', 00178 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3, 00179 $ ' is', 1P, E10.3 ) 00180 END IF 00181 END IF 00182 20 CONTINUE 00183 * 00184 END IF 00185 RETURN 00186 * 00187 * End of SLAFTS 00188 * 00189 END