LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( real  SFAC)

Definition at line 243 of file sblat1.f.

243 * .. Parameters ..
244  INTEGER nout
245  parameter(nout=6)
246 * .. Scalar Arguments ..
247  REAL sfac
248 * .. Scalars in Common ..
249  INTEGER icase, incx, incy, n
250  LOGICAL pass
251 * .. Local Scalars ..
252  INTEGER i, len, np1
253 * .. Local Arrays ..
254  REAL dtrue1(5), dtrue3(5), dtrue5(8,5,2), dv(8,5,2),
255  + sa(10), stemp(1), strue(8), sx(8)
256  INTEGER itrue2(5)
257 * .. External Functions ..
258  REAL sasum, snrm2
259  INTEGER isamax
260  EXTERNAL sasum, snrm2, isamax
261 * .. External Subroutines ..
262  EXTERNAL itest1, sscal, stest, stest1
263 * .. Intrinsic Functions ..
264  INTRINSIC max
265 * .. Common blocks ..
266  COMMON /combla/icase, n, incx, incy, pass
267 * .. Data statements ..
268  DATA sa/0.3e0, -1.0e0, 0.0e0, 1.0e0, 0.3e0, 0.3e0,
269  + 0.3e0, 0.3e0, 0.3e0, 0.3e0/
270  DATA dv/0.1e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0,
271  + 2.0e0, 2.0e0, 0.3e0, 3.0e0, 3.0e0, 3.0e0, 3.0e0,
272  + 3.0e0, 3.0e0, 3.0e0, 0.3e0, -0.4e0, 4.0e0,
273  + 4.0e0, 4.0e0, 4.0e0, 4.0e0, 4.0e0, 0.2e0,
274  + -0.6e0, 0.3e0, 5.0e0, 5.0e0, 5.0e0, 5.0e0,
275  + 5.0e0, 0.1e0, -0.3e0, 0.5e0, -0.1e0, 6.0e0,
276  + 6.0e0, 6.0e0, 6.0e0, 0.1e0, 8.0e0, 8.0e0, 8.0e0,
277  + 8.0e0, 8.0e0, 8.0e0, 8.0e0, 0.3e0, 9.0e0, 9.0e0,
278  + 9.0e0, 9.0e0, 9.0e0, 9.0e0, 9.0e0, 0.3e0, 2.0e0,
279  + -0.4e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0,
280  + 0.2e0, 3.0e0, -0.6e0, 5.0e0, 0.3e0, 2.0e0,
281  + 2.0e0, 2.0e0, 0.1e0, 4.0e0, -0.3e0, 6.0e0,
282  + -0.5e0, 7.0e0, -0.1e0, 3.0e0/
283  DATA dtrue1/0.0e0, 0.3e0, 0.5e0, 0.7e0, 0.6e0/
284  DATA dtrue3/0.0e0, 0.3e0, 0.7e0, 1.1e0, 1.0e0/
285  DATA dtrue5/0.10e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0,
286  + 2.0e0, 2.0e0, 2.0e0, -0.3e0, 3.0e0, 3.0e0,
287  + 3.0e0, 3.0e0, 3.0e0, 3.0e0, 3.0e0, 0.0e0, 0.0e0,
288  + 4.0e0, 4.0e0, 4.0e0, 4.0e0, 4.0e0, 4.0e0,
289  + 0.20e0, -0.60e0, 0.30e0, 5.0e0, 5.0e0, 5.0e0,
290  + 5.0e0, 5.0e0, 0.03e0, -0.09e0, 0.15e0, -0.03e0,
291  + 6.0e0, 6.0e0, 6.0e0, 6.0e0, 0.10e0, 8.0e0,
292  + 8.0e0, 8.0e0, 8.0e0, 8.0e0, 8.0e0, 8.0e0,
293  + 0.09e0, 9.0e0, 9.0e0, 9.0e0, 9.0e0, 9.0e0,
294  + 9.0e0, 9.0e0, 0.09e0, 2.0e0, -0.12e0, 2.0e0,
295  + 2.0e0, 2.0e0, 2.0e0, 2.0e0, 0.06e0, 3.0e0,
296  + -0.18e0, 5.0e0, 0.09e0, 2.0e0, 2.0e0, 2.0e0,
297  + 0.03e0, 4.0e0, -0.09e0, 6.0e0, -0.15e0, 7.0e0,
298  + -0.03e0, 3.0e0/
299  DATA itrue2/0, 1, 2, 2, 3/
300 * .. Executable Statements ..
301  DO 80 incx = 1, 2
302  DO 60 np1 = 1, 5
303  n = np1 - 1
304  len = 2*max(n,1)
305 * .. Set vector arguments ..
306  DO 20 i = 1, len
307  sx(i) = dv(i,np1,incx)
308  20 CONTINUE
309 *
310  IF (icase.EQ.7) THEN
311 * .. SNRM2 ..
312  stemp(1) = dtrue1(np1)
313  CALL stest1(snrm2(n,sx,incx),stemp(1),stemp,sfac)
314  ELSE IF (icase.EQ.8) THEN
315 * .. SASUM ..
316  stemp(1) = dtrue3(np1)
317  CALL stest1(sasum(n,sx,incx),stemp(1),stemp,sfac)
318  ELSE IF (icase.EQ.9) THEN
319 * .. SSCAL ..
320  CALL sscal(n,sa((incx-1)*5+np1),sx,incx)
321  DO 40 i = 1, len
322  strue(i) = dtrue5(i,np1,incx)
323  40 CONTINUE
324  CALL stest(len,sx,strue,strue,sfac)
325  ELSE IF (icase.EQ.10) THEN
326 * .. ISAMAX ..
327  CALL itest1(isamax(n,sx,incx),itrue2(np1))
328  ELSE
329  WRITE (nout,*) ' Shouldn''t be here in CHECK1'
330  stop
331  END IF
332  60 CONTINUE
333  80 CONTINUE
334  RETURN
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:686
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:73
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
real function snrm2(N, X, INCX)
SNRM2
Definition: snrm2.f:76
real function sasum(N, SX, INCX)
SASUM
Definition: sasum.f:74
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:564
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:81
Here is the call graph for this function: