208 lines
		
	
	
		
			5.2 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			208 lines
		
	
	
		
			5.2 KiB
		
	
	
	
		
			Fortran
		
	
	
	
*> \brief \b ZCHKLQT
 | 
						|
*
 | 
						|
*  =========== DOCUMENTATION ===========
 | 
						|
*
 | 
						|
* Online html documentation available at
 | 
						|
*            http://www.netlib.org/lapack/explore-html/
 | 
						|
*
 | 
						|
*  Definition:
 | 
						|
*  ===========
 | 
						|
*
 | 
						|
*       SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
 | 
						|
*                           NBVAL, NOUT )
 | 
						|
*
 | 
						|
*       .. Scalar Arguments ..
 | 
						|
*       LOGICAL            TSTERR
 | 
						|
*       INTEGER            NM, NN, NNB, NOUT
 | 
						|
*       DOUBLE PRECISION   THRESH
 | 
						|
*       ..
 | 
						|
*       .. Array Arguments ..
 | 
						|
*       INTEGER            MVAL( * ), NBVAL( * ), NVAL( * )
 | 
						|
*
 | 
						|
*> \par Purpose:
 | 
						|
*  =============
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*> ZCHKLQT tests ZGELQT and ZUNMLQT.
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Arguments:
 | 
						|
*  ==========
 | 
						|
*
 | 
						|
*> \param[in] THRESH
 | 
						|
*> \verbatim
 | 
						|
*>          THRESH is DOUBLE PRECISION
 | 
						|
*>          The threshold value for the test ratios.  A result is
 | 
						|
*>          included in the output file if RESULT >= THRESH.  To have
 | 
						|
*>          every test ratio printed, use THRESH = 0.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] TSTERR
 | 
						|
*> \verbatim
 | 
						|
*>          TSTERR is LOGICAL
 | 
						|
*>          Flag that indicates whether error exits are to be tested.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] NM
 | 
						|
*> \verbatim
 | 
						|
*>          NM is INTEGER
 | 
						|
*>          The number of values of M contained in the vector MVAL.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] MVAL
 | 
						|
*> \verbatim
 | 
						|
*>          MVAL is INTEGER array, dimension (NM)
 | 
						|
*>          The values of the matrix row dimension M.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] NN
 | 
						|
*> \verbatim
 | 
						|
*>          NN is INTEGER
 | 
						|
*>          The number of values of N contained in the vector NVAL.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] NVAL
 | 
						|
*> \verbatim
 | 
						|
*>          NVAL is INTEGER array, dimension (NN)
 | 
						|
*>          The values of the matrix column dimension N.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] NNB
 | 
						|
*> \verbatim
 | 
						|
*>          NNB is INTEGER
 | 
						|
*>          The number of values of NB contained in the vector NBVAL.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] NBVAL
 | 
						|
*> \verbatim
 | 
						|
*>          NBVAL is INTEGER array, dimension (NNB)
 | 
						|
*>          The values of the blocksize NB.
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] NOUT
 | 
						|
*> \verbatim
 | 
						|
*>          NOUT is INTEGER
 | 
						|
*>          The unit number for output.
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Authors:
 | 
						|
*  ========
 | 
						|
*
 | 
						|
*> \author Univ. of Tennessee
 | 
						|
*> \author Univ. of California Berkeley
 | 
						|
*> \author Univ. of Colorado Denver
 | 
						|
*> \author NAG Ltd.
 | 
						|
*
 | 
						|
*> \ingroup double_lin
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
      SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
 | 
						|
     $                     NBVAL, NOUT )
 | 
						|
      IMPLICIT NONE
 | 
						|
*
 | 
						|
*  -- 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 ..
 | 
						|
      LOGICAL            TSTERR
 | 
						|
      INTEGER            NM, NN, NNB, NOUT
 | 
						|
      DOUBLE PRECISION   THRESH
 | 
						|
*     ..
 | 
						|
*     .. Array Arguments ..
 | 
						|
      INTEGER            MVAL( * ), NBVAL( * ), NVAL( * )
 | 
						|
*     ..
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
*
 | 
						|
*     .. Parameters ..
 | 
						|
      INTEGER            NTESTS
 | 
						|
      PARAMETER          ( NTESTS = 6 )
 | 
						|
*     ..
 | 
						|
*     .. Local Scalars ..
 | 
						|
      CHARACTER*3        PATH
 | 
						|
      INTEGER            I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN,
 | 
						|
     $                   MINMN
 | 
						|
*
 | 
						|
*     .. Local Arrays ..
 | 
						|
      DOUBLE PRECISION   RESULT( NTESTS )
 | 
						|
*     ..
 | 
						|
*     .. External Subroutines ..
 | 
						|
      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRLQT, ZLQT04
 | 
						|
*     ..
 | 
						|
*     .. Scalars in Common ..
 | 
						|
      LOGICAL            LERR, OK
 | 
						|
      CHARACTER*32       SRNAMT
 | 
						|
      INTEGER            INFOT, NUNIT
 | 
						|
*     ..
 | 
						|
*     .. Common blocks ..
 | 
						|
      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
 | 
						|
      COMMON             / SRNAMC / SRNAMT
 | 
						|
*     ..
 | 
						|
*     .. Executable Statements ..
 | 
						|
*
 | 
						|
*     Initialize constants
 | 
						|
*
 | 
						|
      PATH( 1: 1 ) = 'Z'
 | 
						|
      PATH( 2: 3 ) = 'TQ'
 | 
						|
      NRUN = 0
 | 
						|
      NFAIL = 0
 | 
						|
      NERRS = 0
 | 
						|
*
 | 
						|
*     Test the error exits
 | 
						|
*
 | 
						|
      IF( TSTERR ) CALL ZERRLQT( PATH, NOUT )
 | 
						|
      INFOT = 0
 | 
						|
*
 | 
						|
*     Do for each value of M in MVAL.
 | 
						|
*
 | 
						|
      DO I = 1, NM
 | 
						|
         M = MVAL( I )
 | 
						|
*
 | 
						|
*        Do for each value of N in NVAL.
 | 
						|
*
 | 
						|
         DO J = 1, NN
 | 
						|
            N = NVAL( J )
 | 
						|
*
 | 
						|
*        Do for each possible value of NB
 | 
						|
*
 | 
						|
            MINMN = MIN( M, N )
 | 
						|
            DO K = 1, NNB
 | 
						|
               NB = NBVAL( K )
 | 
						|
*
 | 
						|
*              Test ZGELQT and ZUNMLQT
 | 
						|
*
 | 
						|
               IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN
 | 
						|
                  CALL ZLQT04( M, N, NB, RESULT )
 | 
						|
*
 | 
						|
*                 Print information about the tests that did not
 | 
						|
*                 pass the threshold.
 | 
						|
*
 | 
						|
                  DO T = 1, NTESTS
 | 
						|
                     IF( RESULT( T ).GE.THRESH ) THEN
 | 
						|
                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 | 
						|
     $                       CALL ALAHD( NOUT, PATH )
 | 
						|
                        WRITE( NOUT, FMT = 9999 )M, N, NB,
 | 
						|
     $                       T, RESULT( T )
 | 
						|
                        NFAIL = NFAIL + 1
 | 
						|
                     END IF
 | 
						|
                  END DO
 | 
						|
                  NRUN = NRUN + NTESTS
 | 
						|
               END IF
 | 
						|
            END DO
 | 
						|
         END DO
 | 
						|
      END DO
 | 
						|
*
 | 
						|
*     Print a summary of the results.
 | 
						|
*
 | 
						|
      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
 | 
						|
*
 | 
						|
 9999 FORMAT( ' M=', I5, ', N=', I5, ', NB=', I4,
 | 
						|
     $      ' test(', I2, ')=', G12.5 )
 | 
						|
      RETURN
 | 
						|
*
 | 
						|
*     End of ZCHKLQT
 | 
						|
*
 | 
						|
      END
 |