LAPACK  3.8.0 LAPACK: Linear Algebra PACKage
dchktsqr.f
Go to the documentation of this file.
1 *> \brief \b DCHKQRT
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 DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
12 * NBVAL, NOUT )
13 *
14 * .. Scalar Arguments ..
15 * LOGICAL TSTERR
16 * INTEGER NM, NN, NNB, NOUT
17 * DOUBLE PRECISION THRESH
18 * ..
19 * .. Array Arguments ..
20 * INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
21 *
22 *> \par Purpose:
23 * =============
24 *>
25 *> \verbatim
26 *>
27 *> DCHKTSQR tests DGETSQR and DORMTSQR.
28 *> \endverbatim
29 *
30 * Arguments:
31 * ==========
32 *
33 *> \param[in] THRESH
34 *> \verbatim
35 *> THRESH is DOUBLE PRECISION
36 *> The threshold value for the test ratios. A result is
37 *> included in the output file if RESULT >= THRESH. To have
38 *> every test ratio printed, use THRESH = 0.
39 *> \endverbatim
40 *>
41 *> \param[in] TSTERR
42 *> \verbatim
43 *> TSTERR is LOGICAL
44 *> Flag that indicates whether error exits are to be tested.
45 *> \endverbatim
46 *>
47 *> \param[in] NM
48 *> \verbatim
49 *> NM is INTEGER
50 *> The number of values of M contained in the vector MVAL.
51 *> \endverbatim
52 *>
53 *> \param[in] MVAL
54 *> \verbatim
55 *> MVAL is INTEGER array, dimension (NM)
56 *> The values of the matrix row dimension M.
57 *> \endverbatim
58 *>
59 *> \param[in] NN
60 *> \verbatim
61 *> NN is INTEGER
62 *> The number of values of N contained in the vector NVAL.
63 *> \endverbatim
64 *>
65 *> \param[in] NVAL
66 *> \verbatim
67 *> NVAL is INTEGER array, dimension (NN)
68 *> The values of the matrix column dimension N.
69 *> \endverbatim
70 *>
71 *> \param[in] NNB
72 *> \verbatim
73 *> NNB is INTEGER
74 *> The number of values of NB contained in the vector NBVAL.
75 *> \endverbatim
76 *>
77 *> \param[in] NBVAL
78 *> \verbatim
79 *> NBVAL is INTEGER array, dimension (NBVAL)
80 *> The values of the blocksize NB.
81 *> \endverbatim
82 *>
83 *> \param[in] NOUT
84 *> \verbatim
85 *> NOUT is INTEGER
86 *> The unit number for output.
87 *> \endverbatim
88 *
89 * Authors:
90 * ========
91 *
92 *> \author Univ. of Tennessee
93 *> \author Univ. of California Berkeley
94 *> \author Univ. of Colorado Denver
95 *> \author NAG Ltd.
96 *
97 *> \date December 2016
98 *
99 *> \ingroup double_lin
100 *
101 * =====================================================================
102  SUBROUTINE dchktsqr( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
103  \$ NBVAL, NOUT )
104  IMPLICIT NONE
105 *
106 * -- LAPACK test routine (version 3.7.0) --
107 * -- LAPACK is a software package provided by Univ. of Tennessee, --
108 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
109 * December 2016
110 *
111 * .. Scalar Arguments ..
112  LOGICAL TSTERR
113  INTEGER NM, NN, NNB, NOUT
114  DOUBLE PRECISION THRESH
115 * ..
116 * .. Array Arguments ..
117  INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
118 * ..
119 *
120 * =====================================================================
121 *
122 * .. Parameters ..
123  INTEGER NTESTS
124  parameter( ntests = 6 )
125 * ..
126 * .. Local Scalars ..
127  CHARACTER*3 PATH
128  INTEGER I, J, K, T, M, N, NB, NFAIL, NERRS, NRUN, INB,
129  \$ minmn, mb, imb
130 *
131 * .. Local Arrays ..
132  DOUBLE PRECISION RESULT( ntests )
133 * ..
134 * .. External Subroutines ..
135  EXTERNAL alaerh, alahd, alasum, derrtsqr,
136  \$ dtsqr01, xlaenv
137 * ..
138 * .. Intrinsic Functions ..
139  INTRINSIC max, min
140 * ..
141 * .. Scalars in Common ..
142  LOGICAL LERR, OK
143  CHARACTER*32 SRNAMT
144  INTEGER INFOT, NUNIT
145 * ..
146 * .. Common blocks ..
147  COMMON / infoc / infot, nunit, ok, lerr
148  COMMON / srnamc / srnamt
149 * ..
150 * .. Executable Statements ..
151 *
152 * Initialize constants
153 *
154  path( 1: 1 ) = 'D'
155  path( 2: 3 ) = 'TS'
156  nrun = 0
157  nfail = 0
158  nerrs = 0
159 *
160 * Test the error exits
161 *
162  IF( tsterr ) CALL derrtsqr( path, nout )
163  infot = 0
164 *
165 * Do for each value of M in MVAL.
166 *
167  DO i = 1, nm
168  m = mval( i )
169 *
170 * Do for each value of N in NVAL.
171 *
172  DO j = 1, nn
173  n = nval( j )
174  IF (min(m,n).NE.0) THEN
175  DO inb = 1, nnb
176  mb = nbval( inb )
177  CALL xlaenv( 1, mb )
178  DO imb = 1, nnb
179  nb = nbval( imb )
180  CALL xlaenv( 2, nb )
181 *
182 * Test DGEQR and DGEMQR
183 *
184  CALL dtsqr01( 'TS', m, n, mb, nb, result )
185 *
186 * Print information about the tests that did not
187 * pass the threshold.
188 *
189  DO t = 1, ntests
190  IF( result( t ).GE.thresh ) THEN
191  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
192  \$ CALL alahd( nout, path )
193  WRITE( nout, fmt = 9999 )m, n, mb, nb,
194  \$ t, result( t )
195  nfail = nfail + 1
196  END IF
197  END DO
198  nrun = nrun + ntests
199  END DO
200  END DO
201  END IF
202  END DO
203  END DO
204 *
205 * Do for each value of M in MVAL.
206 *
207  DO i = 1, nm
208  m = mval( i )
209 *
210 * Do for each value of N in NVAL.
211 *
212  DO j = 1, nn
213  n = nval( j )
214  IF (min(m,n).NE.0) THEN
215  DO inb = 1, nnb
216  mb = nbval( inb )
217  CALL xlaenv( 1, mb )
218  DO imb = 1, nnb
219  nb = nbval( imb )
220  CALL xlaenv( 2, nb )
221 *
222 * Test DGEQR and DGEMQR
223 *
224  CALL dtsqr01( 'SW', m, n, mb, nb, result )
225 *
226 * Print information about the tests that did not
227 * pass the threshold.
228 *
229  DO t = 1, ntests
230  IF( result( t ).GE.thresh ) THEN
231  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
232  \$ CALL alahd( nout, path )
233  WRITE( nout, fmt = 9998 )m, n, mb, nb,
234  \$ t, result( t )
235  nfail = nfail + 1
236  END IF
237  END DO
238  nrun = nrun + ntests
239  END DO
240  END DO
241  END IF
242  END DO
243  END DO
244 *
245 * Print a summary of the results.
246 *
247  CALL alasum( path, nout, nfail, nrun, nerrs )
248 *
249  9999 FORMAT( 'TS: M=', i5, ', N=', i5, ', MB=', i5,
250  \$ ', NB=', i5,' test(', i2, ')=', g12.5 )
251  9998 FORMAT( 'SW: M=', i5, ', N=', i5, ', MB=', i5,
252  \$ ', NB=', i5,' test(', i2, ')=', g12.5 )
253  RETURN
254 *
255 * End of DCHKQRT
256 *
257  END
subroutine derrtsqr(PATH, NUNIT)
DERRTSQR
Definition: derrtsqr.f:57
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine dtsqr01(TSSW, M, N, MB, NB, RESULT)
DTSQR01
Definition: dtsqr01.f:86
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine dchktsqr(THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
DCHKQRT
Definition: dchktsqr.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75