00001 SUBROUTINE DLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, 00002 $ THRESH, IOUNIT, IE ) 00003 * 00004 * -- LAPACK auxiliary test routine (version 3.1.2) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * April 2009 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER*3 TYPE 00010 INTEGER IE, IMAT, IOUNIT, M, N, NTESTS 00011 DOUBLE PRECISION THRESH 00012 * .. 00013 * .. Array Arguments .. 00014 INTEGER ISEED( 4 ) 00015 DOUBLE PRECISION RESULT( * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * DLAFTS tests the result vector against the threshold value to 00022 * see which tests for this matrix type failed to pass the threshold. 00023 * Output is to the file given by unit IOUNIT. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * TYPE - CHARACTER*3 00029 * On entry, TYPE specifies the matrix type to be used in the 00030 * printed messages. 00031 * Not modified. 00032 * 00033 * N - INTEGER 00034 * On entry, N specifies the order of the test matrix. 00035 * Not modified. 00036 * 00037 * IMAT - INTEGER 00038 * On entry, IMAT specifies the type of the test matrix. 00039 * A listing of the different types is printed by DLAHD2 00040 * to the output file if a test fails to pass the threshold. 00041 * Not modified. 00042 * 00043 * NTESTS - INTEGER 00044 * On entry, NTESTS is the number of tests performed on the 00045 * subroutines in the path given by TYPE. 00046 * Not modified. 00047 * 00048 * RESULT - DOUBLE PRECISION array of dimension( NTESTS ) 00049 * On entry, RESULT contains the test ratios from the tests 00050 * performed in the calling program. 00051 * Not modified. 00052 * 00053 * ISEED - INTEGER array of dimension( 4 ) 00054 * Contains the random seed that generated the matrix used 00055 * for the tests whose ratios are in RESULT. 00056 * Not modified. 00057 * 00058 * THRESH - DOUBLE PRECISION 00059 * On entry, THRESH specifies the acceptable threshold of the 00060 * test ratios. If RESULT( K ) > THRESH, then the K-th test 00061 * did not pass the threshold and a message will be printed. 00062 * Not modified. 00063 * 00064 * IOUNIT - INTEGER 00065 * On entry, IOUNIT specifies the unit number of the file 00066 * to which the messages are printed. 00067 * Not modified. 00068 * 00069 * IE - INTEGER 00070 * On entry, IE contains the number of tests which have 00071 * failed to pass the threshold so far. 00072 * Updated on exit if any of the ratios in RESULT also fail. 00073 * 00074 * ===================================================================== 00075 * 00076 * .. Local Scalars .. 00077 INTEGER K 00078 * .. 00079 * .. External Subroutines .. 00080 EXTERNAL DLAHD2 00081 * .. 00082 * .. Executable Statements .. 00083 * 00084 IF( M.EQ.N ) THEN 00085 * 00086 * Output for square matrices: 00087 * 00088 DO 10 K = 1, NTESTS 00089 IF( RESULT( K ).GE.THRESH ) THEN 00090 * 00091 * If this is the first test to fail, call DLAHD2 00092 * to print a header to the data file. 00093 * 00094 IF( IE.EQ.0 ) 00095 $ CALL DLAHD2( IOUNIT, TYPE ) 00096 IE = IE + 1 00097 IF( RESULT( K ).LT.10000.0D0 ) THEN 00098 WRITE( IOUNIT, FMT = 9999 )N, IMAT, ISEED, K, 00099 $ RESULT( K ) 00100 9999 FORMAT( ' Matrix order=', I5, ', type=', I2, 00101 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is', 00102 $ 0P, F8.2 ) 00103 ELSE 00104 WRITE( IOUNIT, FMT = 9998 )N, IMAT, ISEED, K, 00105 $ RESULT( K ) 00106 9998 FORMAT( ' Matrix order=', I5, ', type=', I2, 00107 $ ', seed=', 4( I4, ',' ), ' result ', I3, ' is', 00108 $ 1P, D10.3 ) 00109 END IF 00110 END IF 00111 10 CONTINUE 00112 ELSE 00113 * 00114 * Output for rectangular matrices 00115 * 00116 DO 20 K = 1, NTESTS 00117 IF( RESULT( K ).GE.THRESH ) THEN 00118 * 00119 * If this is the first test to fail, call DLAHD2 00120 * to print a header to the data file. 00121 * 00122 IF( IE.EQ.0 ) 00123 $ CALL DLAHD2( IOUNIT, TYPE ) 00124 IE = IE + 1 00125 IF( RESULT( K ).LT.10000.0D0 ) THEN 00126 WRITE( IOUNIT, FMT = 9997 )M, N, IMAT, ISEED, K, 00127 $ RESULT( K ) 00128 9997 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s', 00129 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3, 00130 $ ' is', 0P, F8.2 ) 00131 ELSE 00132 WRITE( IOUNIT, FMT = 9996 )M, N, IMAT, ISEED, K, 00133 $ RESULT( K ) 00134 9996 FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s', 00135 $ 'eed=', 3( I4, ',' ), I4, ': result ', I3, 00136 $ ' is', 1P, D10.3 ) 00137 END IF 00138 END IF 00139 20 CONTINUE 00140 * 00141 END IF 00142 RETURN 00143 * 00144 * End of DLAFTS 00145 * 00146 END
1.7.2