LAPACK  3.8.0
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 (NBVAL)
          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.
Date
December 2016

Definition at line 104 of file dchktsqr.f.

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 *
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
Here is the call graph for this function:
Here is the caller graph for this function: