dchktsqr()

subroutine dchktsqr	(	double precision	thresh,
		logical	tsterr,
		integer	nm,
		integer, dimension( * )	mval,
		integer	nn,
		integer, dimension( * )	nval,
		integer	nnb,
		integer, dimension( * )	nbval,
		integer	nout
	)

DCHKQRT

Purpose:

 DCHKTSQR tests DGETSQR and DORMTSQR.

Parameters

[in]	THRESH	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.
[in]	TSTERR	TSTERR is LOGICAL Flag that indicates whether error exits are to be tested.
[in]	NM	NM is INTEGER The number of values of M contained in the vector MVAL.
[in]	MVAL	MVAL is INTEGER array, dimension (NM) The values of the matrix row dimension M.
[in]	NN	NN is INTEGER The number of values of N contained in the vector NVAL.
[in]	NVAL	NVAL is INTEGER array, dimension (NN) The values of the matrix column dimension N.
[in]	NNB	NNB is INTEGER The number of values of NB contained in the vector NBVAL.
[in]	NBVAL	NBVAL is INTEGER array, dimension (NNB) The values of the blocksize NB.
[in]	NOUT	NOUT is INTEGER The unit number for output.

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 100 of file dchktsqr.f.

      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, INB,
     $                   MINMN, MB, IMB
*
*     .. Local Arrays ..
      DOUBLE PRECISION   RESULT( NTESTS )
*     ..
*     .. External Subroutines ..
      EXTERNAL           alaerh, alahd, alasum, derrtsqr,
     $                   dtsqr01, xlaenv
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC  max, min
*     ..
*     .. 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 ) = 'D'
      path( 2: 3 ) = 'TS'
      nrun = 0
      nfail = 0
      nerrs = 0
*
*     Test the error exits
*
      CALL xlaenv( 1, 0 )
      CALL xlaenv( 2, 0 )            
      IF( tsterr ) CALL derrtsqr( 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 )
              IF (min(m,n).NE.0) THEN
              DO inb = 1, nnb
                mb = nbval( inb )
                  CALL xlaenv( 1, mb )
                  DO imb = 1, nnb
                    nb = nbval( imb )
                    CALL xlaenv( 2, nb )
*
*                 Test DGEQR and DGEMQR
*
                    CALL dtsqr01( 'TS', m, n, mb, 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, mb, nb,
     $                       t, result( t )
                        nfail = nfail + 1
                      END IF
                    END DO
                    nrun = nrun + ntests
                  END DO
              END DO
              END IF
         END DO
      END DO
*
*     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 )
              IF (min(m,n).NE.0) THEN
              DO inb = 1, nnb
                mb = nbval( inb )
                  CALL xlaenv( 1, mb )
                  DO imb = 1, nnb
                    nb = nbval( imb )
                    CALL xlaenv( 2, nb )
*
*                 Test DGEQR and DGEMQR
*
                    CALL dtsqr01( 'SW', m, n, mb, 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 = 9998 )m, n, mb, nb,
     $                       t, result( t )
                        nfail = nfail + 1
                      END IF
                    END DO
                    nrun = nrun + ntests
                  END DO
              END DO
              END IF
         END DO
      END DO
*
*     Print a summary of the results.
*
      CALL alasum( path, nout, nfail, nrun, nerrs )
*
 9999 FORMAT( 'TS: M=', i5, ', N=', i5, ', MB=', i5,
     $      ', NB=', i5,' test(', i2, ')=', g12.5 )
 9998 FORMAT( 'SW: M=', i5, ', N=', i5, ', MB=', i5,
     $      ', NB=', i5,' test(', i2, ')=', g12.5 )
      RETURN
*
*     End of DCHKTSQR
*

Here is the call graph for this function:

Here is the caller graph for this function: