LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
schktsqr.f
Go to the documentation of this file.
1 *> \brief \b SCHKQRT
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 SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
12 * NBVAL, NOUT )
13 *
14 * .. Scalar Arguments ..
15 * LOGICAL TSTERR
16 * INTEGER NM, NN, NNB, NOUT
17 * REAL THRESH
18 * ..
19 * .. Array Arguments ..
20 * INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
21 *
22 *> \par Purpose:
23 * =============
24 *>
25 *> \verbatim
26 *>
27 *> SCHKTSQR tests SGETSQR and SORMTSQR.
28 *> \endverbatim
29 *
30 * Arguments:
31 * ==========
32 *
33 *> \param[in] THRESH
34 *> \verbatim
35 *> THRESH is REAL
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 (NNB)
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 *> \ingroup double_lin
98 *
99 * =====================================================================
100  SUBROUTINE schktsqr( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
101  $ NBVAL, NOUT )
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  REAL 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  REAL RESULT( NTESTS )
130 * ..
131 * .. External Subroutines ..
132  EXTERNAL alaerh, alahd, alasum, serrtsqr,
133  $ stsqr01, 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 ) = 'S'
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 serrtsqr( 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 SGEQR and SGEMQR
182 *
183  CALL stsqr01('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 SGEQR and SGEMQR
222 *
223  CALL stsqr01('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 SCHKTSQR
255 *
256  END
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 stsqr01(TSSW, M, N, MB, NB, RESULT)
STSQR01
Definition: stsqr01.f:84
subroutine schktsqr(THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
SCHKQRT
Definition: schktsqr.f:102
subroutine serrtsqr(PATH, NUNIT)
DERRTSQR
Definition: serrtsqr.f:55