LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
cchkunhr_col.f
Go to the documentation of this file.
1 *> \brief \b CCHKUNHR_COL
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 CCHKUNHR_COL( 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 *> CCHKUNHR_COL tests:
28 *> 1) CUNGTSQR and CUNHR_COL using CLATSQR, CGEMQRT,
29 *> 2) CUNGTSQR_ROW and CUNHR_COL inside CGETSQRHRT
30 *> (which calls CLATSQR, CUNGTSQR_ROW and CUNHR_COL) using CGEMQRT.
31 *> Therefore, CLATSQR (part of CGEQR), CGEMQRT (part of CGEMQR)
32 *> have to be tested before this test.
33 *>
34 *> \endverbatim
35 *
36 * Arguments:
37 * ==========
38 *
39 *> \param[in] THRESH
40 *> \verbatim
41 *> THRESH is REAL
42 *> The threshold value for the test ratios. A result is
43 *> included in the output file if RESULT >= THRESH. To have
44 *> every test ratio printed, use THRESH = 0.
45 *> \endverbatim
46 *>
47 *> \param[in] TSTERR
48 *> \verbatim
49 *> TSTERR is LOGICAL
50 *> Flag that indicates whether error exits are to be tested.
51 *> \endverbatim
52 *>
53 *> \param[in] NM
54 *> \verbatim
55 *> NM is INTEGER
56 *> The number of values of M contained in the vector MVAL.
57 *> \endverbatim
58 *>
59 *> \param[in] MVAL
60 *> \verbatim
61 *> MVAL is INTEGER array, dimension (NM)
62 *> The values of the matrix row dimension M.
63 *> \endverbatim
64 *>
65 *> \param[in] NN
66 *> \verbatim
67 *> NN is INTEGER
68 *> The number of values of N contained in the vector NVAL.
69 *> \endverbatim
70 *>
71 *> \param[in] NVAL
72 *> \verbatim
73 *> NVAL is INTEGER array, dimension (NN)
74 *> The values of the matrix column dimension N.
75 *> \endverbatim
76 *>
77 *> \param[in] NNB
78 *> \verbatim
79 *> NNB is INTEGER
80 *> The number of values of NB contained in the vector NBVAL.
81 *> \endverbatim
82 *>
83 *> \param[in] NBVAL
84 *> \verbatim
85 *> NBVAL is INTEGER array, dimension (NNB)
86 *> The values of the blocksize NB.
87 *> \endverbatim
88 *>
89 *> \param[in] NOUT
90 *> \verbatim
91 *> NOUT is INTEGER
92 *> The unit number for output.
93 *> \endverbatim
94 *
95 * Authors:
96 * ========
97 *
98 *> \author Univ. of Tennessee
99 *> \author Univ. of California Berkeley
100 *> \author Univ. of Colorado Denver
101 *> \author NAG Ltd.
102 *
103 *> \ingroup complex_lin
104 *
105 * =====================================================================
106  SUBROUTINE cchkunhr_col( THRESH, TSTERR, NM, MVAL, NN, NVAL,
107  $ NNB, NBVAL, NOUT )
108  IMPLICIT NONE
109 *
110 * -- LAPACK test routine --
111 * -- LAPACK is a software package provided by Univ. of Tennessee, --
112 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
113 *
114 * .. Scalar Arguments ..
115  LOGICAL TSTERR
116  INTEGER NM, NN, NNB, NOUT
117  REAL THRESH
118 * ..
119 * .. Array Arguments ..
120  INTEGER MVAL( * ), NBVAL( * ), NVAL( * )
121 * ..
122 *
123 * =====================================================================
124 *
125 * .. Parameters ..
126  INTEGER NTESTS
127  parameter( ntests = 6 )
128 * ..
129 * .. Local Scalars ..
130  CHARACTER(LEN=3) PATH
131  INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1,
132  $ nb2, nfail, nerrs, nrun
133 *
134 * .. Local Arrays ..
135  REAL RESULT( NTESTS )
136 * ..
137 * .. External Subroutines ..
138  EXTERNAL alahd, alasum, cerrunhr_col, cunhr_col01,
139  $ cunhr_col02
140 * ..
141 * .. Intrinsic Functions ..
142  INTRINSIC max, min
143 * ..
144 * .. Scalars in Common ..
145  LOGICAL LERR, OK
146  CHARACTER(LEN=32) SRNAMT
147  INTEGER INFOT, NUNIT
148 * ..
149 * .. Common blocks ..
150  COMMON / infoc / infot, nunit, ok, lerr
151  COMMON / srnamc / srnamt
152 * ..
153 * .. Executable Statements ..
154 *
155 * Initialize constants
156 *
157  path( 1: 1 ) = 'C'
158  path( 2: 3 ) = 'HH'
159  nrun = 0
160  nfail = 0
161  nerrs = 0
162 *
163 * Test the error exits
164 *
165  IF( tsterr ) CALL cerrunhr_col( path, nout )
166  infot = 0
167 *
168 * Do for each value of M in MVAL.
169 *
170  DO i = 1, nm
171  m = mval( i )
172 *
173 * Do for each value of N in NVAL.
174 *
175  DO j = 1, nn
176  n = nval( j )
177 *
178 * Only for M >= N
179 *
180  IF ( min( m, n ).GT.0 .AND. m.GE.n ) THEN
181 *
182 * Do for each possible value of MB1
183 *
184  DO imb1 = 1, nnb
185  mb1 = nbval( imb1 )
186 *
187 * Only for MB1 > N
188 *
189  IF ( mb1.GT.n ) THEN
190 *
191 * Do for each possible value of NB1
192 *
193  DO inb1 = 1, nnb
194  nb1 = nbval( inb1 )
195 *
196 * Do for each possible value of NB2
197 *
198  DO inb2 = 1, nnb
199  nb2 = nbval( inb2 )
200 *
201  IF( nb1.GT.0 .AND. nb2.GT.0 ) THEN
202 *
203 * Test CUNHR_COL
204 *
205  CALL cunhr_col01( m, n, mb1, nb1,
206  $ nb2, result )
207 *
208 * Print information about the tests that did
209 * not pass the threshold.
210 *
211  DO t = 1, ntests
212  IF( result( t ).GE.thresh ) THEN
213  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
214  $ CALL alahd( nout, path )
215  WRITE( nout, fmt = 9999 ) m, n, mb1,
216  $ nb1, nb2, t, result( t )
217  nfail = nfail + 1
218  END IF
219  END DO
220  nrun = nrun + ntests
221  END IF
222  END DO
223  END DO
224  END IF
225  END DO
226  END IF
227  END DO
228  END DO
229 *
230 * Do for each value of M in MVAL.
231 *
232  DO i = 1, nm
233  m = mval( i )
234 *
235 * Do for each value of N in NVAL.
236 *
237  DO j = 1, nn
238  n = nval( j )
239 *
240 * Only for M >= N
241 *
242  IF ( min( m, n ).GT.0 .AND. m.GE.n ) THEN
243 *
244 * Do for each possible value of MB1
245 *
246  DO imb1 = 1, nnb
247  mb1 = nbval( imb1 )
248 *
249 * Only for MB1 > N
250 *
251  IF ( mb1.GT.n ) THEN
252 *
253 * Do for each possible value of NB1
254 *
255  DO inb1 = 1, nnb
256  nb1 = nbval( inb1 )
257 *
258 * Do for each possible value of NB2
259 *
260  DO inb2 = 1, nnb
261  nb2 = nbval( inb2 )
262 *
263  IF( nb1.GT.0 .AND. nb2.GT.0 ) THEN
264 *
265 * Test CUNHR_COL
266 *
267  CALL cunhr_col02( m, n, mb1, nb1,
268  $ nb2, result )
269 *
270 * Print information about the tests that did
271 * not pass the threshold.
272 *
273  DO t = 1, ntests
274  IF( result( t ).GE.thresh ) THEN
275  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
276  $ CALL alahd( nout, path )
277  WRITE( nout, fmt = 9998 ) m, n, mb1,
278  $ nb1, nb2, t, result( t )
279  nfail = nfail + 1
280  END IF
281  END DO
282  nrun = nrun + ntests
283  END IF
284  END DO
285  END DO
286  END IF
287  END DO
288  END IF
289  END DO
290  END DO
291 *
292 * Print a summary of the results.
293 *
294  CALL alasum( path, nout, nfail, nrun, nerrs )
295 *
296  9999 FORMAT( 'CUNGTSQR and CUNHR_COL: M=', i5, ', N=', i5,
297  $ ', MB1=', i5, ', NB1=', i5, ', NB2=', i5,
298  $ ' test(', i2, ')=', g12.5 )
299  9998 FORMAT( 'CUNGTSQR_ROW and CUNHR_COL: M=', i5, ', N=', i5,
300  $ ', MB1=', i5, ', NB1=', i5, ', NB2=', i5,
301  $ ' test(', i2, ')=', g12.5 )
302  RETURN
303 *
304 * End of CCHKUNHR_COL
305 *
306  END
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine cerrunhr_col(PATH, NUNIT)
CERRUNHR_COL
Definition: cerrunhr_col.f:56
subroutine cchkunhr_col(THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
CCHKUNHR_COL
Definition: cchkunhr_col.f:108
subroutine cunhr_col01(M, N, MB1, NB1, NB2, RESULT)
CUNHR_COL01
Definition: cunhr_col01.f:119
subroutine cunhr_col02(M, N, MB1, NB1, NB2, RESULT)
CUNHR_COL02
Definition: cunhr_col02.f:120