LAPACK 3.3.0

slafts.f

Go to the documentation of this file.
00001       SUBROUTINE SLAFTS( 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       REAL               THRESH
00012 *     ..
00013 *     .. Array Arguments ..
00014       INTEGER            ISEED( 4 )
00015       REAL               RESULT( * )
00016 *     ..
00017 *
00018 *  Purpose
00019 *  =======
00020 *
00021 *     SLAFTS 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 SLAHD2
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 - REAL               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 - REAL
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           SLAHD2
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 SLAHD2
00092 *           to print a header to the data file.
00093 *
00094                IF( IE.EQ.0 )
00095      $            CALL SLAHD2( IOUNIT, TYPE )
00096                IE = IE + 1
00097                IF( RESULT( K ).LT.10000.0 ) 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, E10.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 SLAHD2
00120 *              to print a header to the data file.
00121 *
00122                IF( IE.EQ.0 )
00123      $            CALL SLAHD2( IOUNIT, TYPE )
00124                IE = IE + 1
00125                IF( RESULT( K ).LT.10000.0 ) 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, E10.3 )
00137                END IF
00138             END IF
00139    20    CONTINUE
00140 *
00141       END IF
00142       RETURN
00143 *
00144 *     End of SLAFTS
00145 *
00146       END
 All Files Functions