LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( double precision  SFAC)

Definition at line 243 of file dblat1.f.

243 * .. Parameters ..
244  INTEGER nout
245  parameter(nout=6)
246 * .. Scalar Arguments ..
247  DOUBLE PRECISION 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  DOUBLE PRECISION 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  DOUBLE PRECISION dasum, dnrm2
259  INTEGER idamax
260  EXTERNAL dasum, dnrm2, idamax
261 * .. External Subroutines ..
262  EXTERNAL itest1, dscal, 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.3d0, -1.0d0, 0.0d0, 1.0d0, 0.3d0, 0.3d0,
269  + 0.3d0, 0.3d0, 0.3d0, 0.3d0/
270  DATA dv/0.1d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
271  + 2.0d0, 2.0d0, 0.3d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0,
272  + 3.0d0, 3.0d0, 3.0d0, 0.3d0, -0.4d0, 4.0d0,
273  + 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 0.2d0,
274  + -0.6d0, 0.3d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0,
275  + 5.0d0, 0.1d0, -0.3d0, 0.5d0, -0.1d0, 6.0d0,
276  + 6.0d0, 6.0d0, 6.0d0, 0.1d0, 8.0d0, 8.0d0, 8.0d0,
277  + 8.0d0, 8.0d0, 8.0d0, 8.0d0, 0.3d0, 9.0d0, 9.0d0,
278  + 9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 0.3d0, 2.0d0,
279  + -0.4d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
280  + 0.2d0, 3.0d0, -0.6d0, 5.0d0, 0.3d0, 2.0d0,
281  + 2.0d0, 2.0d0, 0.1d0, 4.0d0, -0.3d0, 6.0d0,
282  + -0.5d0, 7.0d0, -0.1d0, 3.0d0/
283  DATA dtrue1/0.0d0, 0.3d0, 0.5d0, 0.7d0, 0.6d0/
284  DATA dtrue3/0.0d0, 0.3d0, 0.7d0, 1.1d0, 1.0d0/
285  DATA dtrue5/0.10d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
286  + 2.0d0, 2.0d0, 2.0d0, -0.3d0, 3.0d0, 3.0d0,
287  + 3.0d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0, 0.0d0, 0.0d0,
288  + 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0,
289  + 0.20d0, -0.60d0, 0.30d0, 5.0d0, 5.0d0, 5.0d0,
290  + 5.0d0, 5.0d0, 0.03d0, -0.09d0, 0.15d0, -0.03d0,
291  + 6.0d0, 6.0d0, 6.0d0, 6.0d0, 0.10d0, 8.0d0,
292  + 8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0,
293  + 0.09d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0,
294  + 9.0d0, 9.0d0, 0.09d0, 2.0d0, -0.12d0, 2.0d0,
295  + 2.0d0, 2.0d0, 2.0d0, 2.0d0, 0.06d0, 3.0d0,
296  + -0.18d0, 5.0d0, 0.09d0, 2.0d0, 2.0d0, 2.0d0,
297  + 0.03d0, 4.0d0, -0.09d0, 6.0d0, -0.15d0, 7.0d0,
298  + -0.03d0, 3.0d0/
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 * .. DNRM2 ..
312  stemp(1) = dtrue1(np1)
313  CALL stest1(dnrm2(n,sx,incx),stemp(1),stemp,sfac)
314  ELSE IF (icase.EQ.8) THEN
315 * .. DASUM ..
316  stemp(1) = dtrue3(np1)
317  CALL stest1(dasum(n,sx,incx),stemp(1),stemp,sfac)
318  ELSE IF (icase.EQ.9) THEN
319 * .. DSCAL ..
320  CALL dscal(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 * .. IDAMAX ..
327  CALL itest1(idamax(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
double precision function dnrm2(N, X, INCX)
DNRM2
Definition: dnrm2.f:76
double precision function dasum(N, DX, INCX)
DASUM
Definition: dasum.f:73
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:686
subroutine dscal(N, DA, DX, INCX)
DSCAL
Definition: dscal.f:81
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:73
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:564
Here is the call graph for this function: