LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zchktsqr()

subroutine zchktsqr ( double precision  thresh,
logical  tsterr,
integer  nm,
integer, dimension( * )  mval,
integer  nn,
integer, dimension( * )  nval,
integer  nnb,
integer, dimension( * )  nbval,
integer  nout 
)

DCHKQRT

Purpose:
 ZCHKTSQR tests ZGEQR and ZGEMQR.
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 (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 100 of file zchktsqr.f.

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 DOUBLE PRECISION 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 DOUBLE PRECISION RESULT( NTESTS )
130* ..
131* .. External Subroutines ..
132 EXTERNAL alaerh, alahd, alasum, zerrtsqr,
133 $ ztsqr01, 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 ) = 'Z'
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 zerrtsqr( 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 ZGEQR and ZGEMQR
182*
183 CALL ztsqr01( '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 ZGELQ and ZGEMLQ
222*
223 CALL ztsqr01( '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 ZCHKTSQR
255*
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
Definition alaerh.f:147
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
subroutine zerrtsqr(path, nunit)
ZERRTSQR
Definition zerrtsqr.f:55
subroutine ztsqr01(tssw, m, n, mb, nb, result)
ZTSQR01
Definition ztsqr01.f:82
Here is the call graph for this function:
Here is the caller graph for this function: