LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cchkunhr_col()

subroutine cchkunhr_col ( real  THRESH,
logical  TSTERR,
integer  NM,
integer, dimension( * )  MVAL,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NOUT 
)

CCHKUNHR_COL

Purpose:
 CCHKUNHR_COL tests:
   1) CUNGTSQR and CUNHR_COL using CLATSQR, CGEMQRT,
   2) CUNGTSQR_ROW and CUNHR_COL inside CGETSQRHRT
      (which calls CLATSQR, CUNGTSQR_ROW and CUNHR_COL) using CGEMQRT.
 Therefore, CLATSQR (part of CGEQR), CGEMQRT (part of CGEMQR)
 have to be tested before this test.
Parameters
[in]THRESH
          THRESH is REAL
          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 106 of file cchkunhr_col.f.

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 *
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 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
Here is the call graph for this function:
Here is the caller graph for this function: