LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ 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.

102  IMPLICIT NONE
103 *
104 * -- LAPACK test routine --
105 * -- LAPACK is a software package provided by Univ. of Tennessee, --
106 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
107 *
108 * .. Scalar Arguments ..
109  LOGICAL TSTERR
110  INTEGER NM, NN, NNB, NOUT
111  DOUBLE PRECISION THRESH
112 * ..
113 * .. Array Arguments ..
114  INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
115 * ..
116 *
117 * =====================================================================
118 *
119 * .. Parameters ..
120  INTEGER NTESTS
121  parameter( ntests = 6 )
122 * ..
123 * .. Local Scalars ..
124  CHARACTER*3 PATH
125  INTEGER I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN, INB,
126  $ MINMN, MB, IMB
127 *
128 * .. Local Arrays ..
129  DOUBLE PRECISION RESULT( NTESTS )
130 * ..
131 * .. External Subroutines ..
132  EXTERNAL alaerh, alahd, alasum, derrtsqr,
133  $ dtsqr01, xlaenv
134 * ..
135 * .. Intrinsic Functions ..
136  INTRINSIC max, min
137 * ..
138 * .. Scalars in Common ..
139  LOGICAL LERR, OK
140  CHARACTER*32 SRNAMT
141  INTEGER INFOT, NUNIT
142 * ..
143 * .. Common blocks ..
144  COMMON / infoc / infot, nunit, ok, lerr
145  COMMON / srnamc / srnamt
146 * ..
147 * .. Executable Statements ..
148 *
149 * Initialize constants
150 *
151  path( 1: 1 ) = 'D'
152  path( 2: 3 ) = 'TS'
153  nrun = 0
154  nfail = 0
155  nerrs = 0
156 *
157 * Test the error exits
158 *
159  CALL xlaenv( 1, 0 )
160  CALL xlaenv( 2, 0 )
161  IF( tsterr ) CALL derrtsqr( path, nout )
162  infot = 0
163 *
164 * Do for each value of M in MVAL.
165 *
166  DO i = 1, nm
167  m = mval( i )
168 *
169 * Do for each value of N in NVAL.
170 *
171  DO j = 1, nn
172  n = nval( j )
173  IF (min(m,n).NE.0) THEN
174  DO inb = 1, nnb
175  mb = nbval( inb )
176  CALL xlaenv( 1, mb )
177  DO imb = 1, nnb
178  nb = nbval( imb )
179  CALL xlaenv( 2, nb )
180 *
181 * Test DGEQR and DGEMQR
182 *
183  CALL dtsqr01( 'TS', m, n, mb, nb, result )
184 *
185 * Print information about the tests that did not
186 * pass the threshold.
187 *
188  DO t = 1, ntests
189  IF( result( t ).GE.thresh ) THEN
190  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
191  $ CALL alahd( nout, path )
192  WRITE( nout, fmt = 9999 )m, n, mb, nb,
193  $ t, result( t )
194  nfail = nfail + 1
195  END IF
196  END DO
197  nrun = nrun + ntests
198  END DO
199  END DO
200  END IF
201  END DO
202  END DO
203 *
204 * Do for each value of M in MVAL.
205 *
206  DO i = 1, nm
207  m = mval( i )
208 *
209 * Do for each value of N in NVAL.
210 *
211  DO j = 1, nn
212  n = nval( j )
213  IF (min(m,n).NE.0) THEN
214  DO inb = 1, nnb
215  mb = nbval( inb )
216  CALL xlaenv( 1, mb )
217  DO imb = 1, nnb
218  nb = nbval( imb )
219  CALL xlaenv( 2, nb )
220 *
221 * Test DGEQR and DGEMQR
222 *
223  CALL dtsqr01( 'SW', m, n, mb, nb, result )
224 *
225 * Print information about the tests that did not
226 * pass the threshold.
227 *
228  DO t = 1, ntests
229  IF( result( t ).GE.thresh ) THEN
230  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
231  $ CALL alahd( nout, path )
232  WRITE( nout, fmt = 9998 )m, n, mb, nb,
233  $ t, result( t )
234  nfail = nfail + 1
235  END IF
236  END DO
237  nrun = nrun + ntests
238  END DO
239  END DO
240  END IF
241  END DO
242  END DO
243 *
244 * Print a summary of the results.
245 *
246  CALL alasum( path, nout, nfail, nrun, nerrs )
247 *
248  9999 FORMAT( 'TS: M=', i5, ', N=', i5, ', MB=', i5,
249  $ ', NB=', i5,' test(', i2, ')=', g12.5 )
250  9998 FORMAT( 'SW: M=', i5, ', N=', i5, ', MB=', i5,
251  $ ', NB=', i5,' test(', i2, ')=', g12.5 )
252  RETURN
253 *
254 * End of DCHKTSQR
255 *
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
subroutine derrtsqr(PATH, NUNIT)
DERRTSQR
Definition: derrtsqr.f:55
subroutine dtsqr01(TSSW, M, N, MB, NB, RESULT)
DTSQR01
Definition: dtsqr01.f:84
Here is the call graph for this function:
Here is the caller graph for this function: