TESTING/EIG/slafts.f

   1 *> \brief \b SLAFTS
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE SLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED,
  12 *                          THRESH, IOUNIT, IE )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       CHARACTER*3        TYPE
  16 *       INTEGER            IE, IMAT, IOUNIT, M, N, NTESTS
  17 *       REAL               THRESH
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       INTEGER            ISEED( 4 )
  21 *       REAL               RESULT( * )
  22 *       ..
  23 *
  24 *
  25 *> \par Purpose:
  26 *  =============
  27 *>
  28 *> \verbatim
  29 *>
  30 *>    SLAFTS tests the result vector against the threshold value to
  31 *>    see which tests for this matrix type failed to pass the threshold.
  32 *>    Output is to the file given by unit IOUNIT.
  33 *> \endverbatim
  34 *
  35 *  Arguments:
  36 *  ==========
  37 *
  38 *> \verbatim
  39 *>  TYPE   - CHARACTER*3
  40 *>           On entry, TYPE specifies the matrix type to be used in the
  41 *>           printed messages.
  42 *>           Not modified.
  43 *>
  44 *>  N      - INTEGER
  45 *>           On entry, N specifies the order of the test matrix.
  46 *>           Not modified.
  47 *>
  48 *>  IMAT   - INTEGER
  49 *>           On entry, IMAT specifies the type of the test matrix.
  50 *>           A listing of the different types is printed by SLAHD2
  51 *>           to the output file if a test fails to pass the threshold.
  52 *>           Not modified.
  53 *>
  54 *>  NTESTS - INTEGER
  55 *>           On entry, NTESTS is the number of tests performed on the
  56 *>           subroutines in the path given by TYPE.
  57 *>           Not modified.
  58 *>
  59 *>  RESULT - REAL               array of dimension( NTESTS )
  60 *>           On entry, RESULT contains the test ratios from the tests
  61 *>           performed in the calling program.
  62 *>           Not modified.
  63 *>
  64 *>  ISEED  - INTEGER            array of dimension( 4 )
  65 *>           Contains the random seed that generated the matrix used
  66 *>           for the tests whose ratios are in RESULT.
  67 *>           Not modified.
  68 *>
  69 *>  THRESH - REAL
  70 *>           On entry, THRESH specifies the acceptable threshold of the
  71 *>           test ratios.  If RESULT( K ) > THRESH, then the K-th test
  72 *>           did not pass the threshold and a message will be printed.
  73 *>           Not modified.
  74 *>
  75 *>  IOUNIT - INTEGER
  76 *>           On entry, IOUNIT specifies the unit number of the file
  77 *>           to which the messages are printed.
  78 *>           Not modified.
  79 *>
  80 *>  IE     - INTEGER
  81 *>           On entry, IE contains the number of tests which have
  82 *>           failed to pass the threshold so far.
  83 *>           Updated on exit if any of the ratios in RESULT also fail.
  84 *> \endverbatim
  85 *
  86 *  Authors:
  87 *  ========
  88 *
  89 *> \author Univ. of Tennessee
  90 *> \author Univ. of California Berkeley
  91 *> \author Univ. of Colorado Denver
  92 *> \author NAG Ltd.
  93 *
  94 *> \date November 2011
  95 *
  96 *> \ingroup single_eig
  97 *
  98 *  =====================================================================
  99       SUBROUTINE SLAFTS( TYPE, M, N, IMAT, NTESTS, RESULT, ISEED,
 100      $                   THRESH, IOUNIT, IE )
 101 *
 102 *  -- LAPACK test routine (version 3.4.0) --
 103 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 104 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 105 *     November 2011
 106 *
 107 *     .. Scalar Arguments ..
 108       CHARACTER*3        TYPE
 109       INTEGER            IE, IMAT, IOUNIT, M, N, NTESTS
 110       REAL               THRESH
 111 *     ..
 112 *     .. Array Arguments ..
 113       INTEGER            ISEED( 4 )
 114       REAL               RESULT( * )
 115 *     ..
 116 *
 117 *  =====================================================================
 118 *
 119 *     .. Local Scalars ..
 120       INTEGER            K
 121 *     ..
 122 *     .. External Subroutines ..
 123       EXTERNAL           SLAHD2
 124 *     ..
 125 *     .. Executable Statements ..
 126 *
 127       IF( M.EQ.N ) THEN
 128 *
 129 *     Output for square matrices:
 130 *
 131          DO 10 K = 1, NTESTS
 132             IF( RESULT( K ).GE.THRESH ) THEN
 133 *
 134 *           If this is the first test to fail, call SLAHD2
 135 *           to print a header to the data file.
 136 *
 137                IF( IE.EQ.0 )
 138      $            CALL SLAHD2( IOUNIT, TYPE )
 139                IE = IE + 1
 140                IF( RESULT( K ).LT.10000.0 ) THEN
 141                   WRITE( IOUNIT, FMT = 9999 )N, IMAT, ISEED, K,
 142      $               RESULT( K )
 143  9999             FORMAT( ' Matrix order=', I5, ', type=', I2,
 144      $                  ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
 145      $                  0P, F8.2 )
 146                ELSE
 147                   WRITE( IOUNIT, FMT = 9998 )N, IMAT, ISEED, K,
 148      $               RESULT( K )
 149  9998             FORMAT( ' Matrix order=', I5, ', type=', I2,
 150      $                  ', seed=', 4( I4, ',' ), ' result ', I3, ' is',
 151      $                  1P, E10.3 )
 152                END IF
 153             END IF
 154    10    CONTINUE
 155       ELSE
 156 *
 157 *     Output for rectangular matrices
 158 *
 159          DO 20 K = 1, NTESTS
 160             IF( RESULT( K ).GE.THRESH ) THEN
 161 *
 162 *              If this is the first test to fail, call SLAHD2
 163 *              to print a header to the data file.
 164 *
 165                IF( IE.EQ.0 )
 166      $            CALL SLAHD2( IOUNIT, TYPE )
 167                IE = IE + 1
 168                IF( RESULT( K ).LT.10000.0 ) THEN
 169                   WRITE( IOUNIT, FMT = 9997 )M, N, IMAT, ISEED, K,
 170      $               RESULT( K )
 171  9997             FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
 172      $                  'eed=', 3( I4, ',' ), I4, ': result ', I3,
 173      $                  ' is', 0P, F8.2 )
 174                ELSE
 175                   WRITE( IOUNIT, FMT = 9996 )M, N, IMAT, ISEED, K,
 176      $               RESULT( K )
 177  9996             FORMAT( 1X, I5, ' x', I5, ' matrix, type=', I2, ', s',
 178      $                  'eed=', 3( I4, ',' ), I4, ': result ', I3,
 179      $                  ' is', 1P, E10.3 )
 180                END IF
 181             END IF
 182    20    CONTINUE
 183 *
 184       END IF
 185       RETURN
 186 *
 187 *     End of SLAFTS
 188 *
 189       END