slafts()

subroutine slafts	(	character*3	type,
		integer	m,
		integer	n,
		integer	imat,
		integer	ntests,
		real, dimension( * )	result,
		integer, dimension( 4 )	iseed,
		real	thresh,
		integer	iounit,
		integer	ie )

SLAFTS

Purpose:

!>
!>    SLAFTS tests the result vector against the threshold value to
!>    see which tests for this matrix type failed to pass the threshold.
!>    Output is to the file given by unit IOUNIT.
!> 

!>  TYPE   - CHARACTER*3
!>           On entry, TYPE specifies the matrix type to be used in the
!>           printed messages.
!>           Not modified.
!>
!>  N      - INTEGER
!>           On entry, N specifies the order of the test matrix.
!>           Not modified.
!>
!>  IMAT   - INTEGER
!>           On entry, IMAT specifies the type of the test matrix.
!>           A listing of the different types is printed by SLAHD2
!>           to the output file if a test fails to pass the threshold.
!>           Not modified.
!>
!>  NTESTS - INTEGER
!>           On entry, NTESTS is the number of tests performed on the
!>           subroutines in the path given by TYPE.
!>           Not modified.
!>
!>  RESULT - REAL               array of dimension( NTESTS )
!>           On entry, RESULT contains the test ratios from the tests
!>           performed in the calling program.
!>           Not modified.
!>
!>  ISEED  - INTEGER            array of dimension( 4 )
!>           Contains the random seed that generated the matrix used
!>           for the tests whose ratios are in RESULT.
!>           Not modified.
!>
!>  THRESH - REAL
!>           On entry, THRESH specifies the acceptable threshold of the
!>           test ratios.  If RESULT( K ) > THRESH, then the K-th test
!>           did not pass the threshold and a message will be printed.
!>           Not modified.
!>
!>  IOUNIT - INTEGER
!>           On entry, IOUNIT specifies the unit number of the file
!>           to which the messages are printed.
!>           Not modified.
!>
!>  IE     - INTEGER
!>           On entry, IE contains the number of tests which have
!>           failed to pass the threshold so far.
!>           Updated on exit if any of the ratios in RESULT also fail.
!> 

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 97 of file slafts.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*3        TYPE
      INTEGER            IE, IMAT, IOUNIT, M, N, NTESTS
      REAL               THRESH
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED( 4 )
      REAL               RESULT( * )
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      INTEGER            K
*     ..
*     .. External Subroutines ..
      EXTERNAL           slahd2
*     ..
*     .. Executable Statements ..
*
      IF( m.EQ.n ) THEN
*
*     Output for square matrices:
*
         DO 10 k = 1, ntests
            IF( result( k ).GE.thresh ) THEN
*
*           If this is the first test to fail, call SLAHD2
*           to print a header to the data file.
*
               IF( ie.EQ.0 )
     $            CALL slahd2( iounit, TYPE )
               ie = ie + 1
               IF( result( k ).LT.10000.0 ) THEN
                  WRITE( iounit, fmt = 9999 )n, imat, iseed, k,
     $               result( k )
 9999             FORMAT( ' Matrix order=', i5, ', type=', i2,
     $                  ', seed=', 4( i4, ',' ), ' result ', i3, ' is',
     $                  0p, f8.2 )
               ELSE
                  WRITE( iounit, fmt = 9998 )n, imat, iseed, k,
     $               result( k )
 9998             FORMAT( ' Matrix order=', i5, ', type=', i2,
     $                  ', seed=', 4( i4, ',' ), ' result ', i3, ' is',
     $                  1p, e10.3 )
               END IF
            END IF
   10    CONTINUE
      ELSE
*
*     Output for rectangular matrices
*
         DO 20 k = 1, ntests
            IF( result( k ).GE.thresh ) THEN
*
*              If this is the first test to fail, call SLAHD2
*              to print a header to the data file.
*
               IF( ie.EQ.0 )
     $            CALL slahd2( iounit, TYPE )
               ie = ie + 1
               IF( result( k ).LT.10000.0 ) THEN
                  WRITE( iounit, fmt = 9997 )m, n, imat, iseed, k,
     $               result( k )
 9997             FORMAT( 1x, i5, ' x', i5, ' matrix, type=', i2, ', s',
     $                  'eed=', 3( i4, ',' ), i4, ': result ', i3,
     $                  ' is', 0p, f8.2 )
               ELSE
                  WRITE( iounit, fmt = 9996 )m, n, imat, iseed, k,
     $               result( k )
 9996             FORMAT( 1x, i5, ' x', i5, ' matrix, type=', i2, ', s',
     $                  'eed=', 3( i4, ',' ), i4, ': result ', i3,
     $                  ' is', 1p, e10.3 )
               END IF
            END IF
   20    CONTINUE
*
      END IF
      RETURN
*
*     End of SLAFTS
*

Here is the call graph for this function:

Here is the caller graph for this function: