LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ check1()

subroutine check1 ( double precision  SFAC)

Definition at line 248 of file dblat1.f.

249 * .. Parameters ..
250  INTEGER NOUT
251  parameter(nout=6)
252 * .. Scalar Arguments ..
253  DOUBLE PRECISION SFAC
254 * .. Scalars in Common ..
255  INTEGER ICASE, INCX, INCY, N
256  LOGICAL PASS
257 * .. Local Scalars ..
258  INTEGER I, IX, LEN, NP1
259 * .. Local Arrays ..
260  DOUBLE PRECISION DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
261  + DVR(8), SA(10), STEMP(1), STRUE(8), SX(8),
262  + SXR(15)
263  INTEGER ITRUE2(5), ITRUEC(5)
264 * .. External Functions ..
265  DOUBLE PRECISION DASUM, DNRM2
266  INTEGER IDAMAX
267  EXTERNAL dasum, dnrm2, idamax
268 * .. External Subroutines ..
269  EXTERNAL itest1, dscal, stest, stest1
270 * .. Intrinsic Functions ..
271  INTRINSIC max
272 * .. Common blocks ..
273  COMMON /combla/icase, n, incx, incy, pass
274 * .. Data statements ..
275  DATA sa/0.3d0, -1.0d0, 0.0d0, 1.0d0, 0.3d0, 0.3d0,
276  + 0.3d0, 0.3d0, 0.3d0, 0.3d0/
277  DATA dv/0.1d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
278  + 2.0d0, 2.0d0, 0.3d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0,
279  + 3.0d0, 3.0d0, 3.0d0, 0.3d0, -0.4d0, 4.0d0,
280  + 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 0.2d0,
281  + -0.6d0, 0.3d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0,
282  + 5.0d0, 0.1d0, -0.3d0, 0.5d0, -0.1d0, 6.0d0,
283  + 6.0d0, 6.0d0, 6.0d0, 0.1d0, 8.0d0, 8.0d0, 8.0d0,
284  + 8.0d0, 8.0d0, 8.0d0, 8.0d0, 0.3d0, 9.0d0, 9.0d0,
285  + 9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 0.3d0, 2.0d0,
286  + -0.4d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
287  + 0.2d0, 3.0d0, -0.6d0, 5.0d0, 0.3d0, 2.0d0,
288  + 2.0d0, 2.0d0, 0.1d0, 4.0d0, -0.3d0, 6.0d0,
289  + -0.5d0, 7.0d0, -0.1d0, 3.0d0/
290  DATA dvr/8.0d0, -7.0d0, 9.0d0, 5.0d0, 9.0d0, 8.0d0,
291  + 7.0d0, 7.0d0/
292  DATA dtrue1/0.0d0, 0.3d0, 0.5d0, 0.7d0, 0.6d0/
293  DATA dtrue3/0.0d0, 0.3d0, 0.7d0, 1.1d0, 1.0d0/
294  DATA dtrue5/0.10d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
295  + 2.0d0, 2.0d0, 2.0d0, -0.3d0, 3.0d0, 3.0d0,
296  + 3.0d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0, 0.0d0, 0.0d0,
297  + 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0,
298  + 0.20d0, -0.60d0, 0.30d0, 5.0d0, 5.0d0, 5.0d0,
299  + 5.0d0, 5.0d0, 0.03d0, -0.09d0, 0.15d0, -0.03d0,
300  + 6.0d0, 6.0d0, 6.0d0, 6.0d0, 0.10d0, 8.0d0,
301  + 8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0,
302  + 0.09d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0,
303  + 9.0d0, 9.0d0, 0.09d0, 2.0d0, -0.12d0, 2.0d0,
304  + 2.0d0, 2.0d0, 2.0d0, 2.0d0, 0.06d0, 3.0d0,
305  + -0.18d0, 5.0d0, 0.09d0, 2.0d0, 2.0d0, 2.0d0,
306  + 0.03d0, 4.0d0, -0.09d0, 6.0d0, -0.15d0, 7.0d0,
307  + -0.03d0, 3.0d0/
308  DATA itrue2/0, 1, 2, 2, 3/
309  DATA itruec/0, 1, 1, 1, 1/
310 * .. Executable Statements ..
311  DO 80 incx = 1, 2
312  DO 60 np1 = 1, 5
313  n = np1 - 1
314  len = 2*max(n,1)
315 * .. Set vector arguments ..
316  DO 20 i = 1, len
317  sx(i) = dv(i,np1,incx)
318  20 CONTINUE
319 *
320  IF (icase.EQ.7) THEN
321 * .. DNRM2 ..
322  stemp(1) = dtrue1(np1)
323  CALL stest1(dnrm2(n,sx,incx),stemp(1),stemp,sfac)
324  ELSE IF (icase.EQ.8) THEN
325 * .. DASUM ..
326  stemp(1) = dtrue3(np1)
327  CALL stest1(dasum(n,sx,incx),stemp(1),stemp,sfac)
328  ELSE IF (icase.EQ.9) THEN
329 * .. DSCAL ..
330  CALL dscal(n,sa((incx-1)*5+np1),sx,incx)
331  DO 40 i = 1, len
332  strue(i) = dtrue5(i,np1,incx)
333  40 CONTINUE
334  CALL stest(len,sx,strue,strue,sfac)
335  ELSE IF (icase.EQ.10) THEN
336 * .. IDAMAX ..
337  CALL itest1(idamax(n,sx,incx),itrue2(np1))
338  DO 100 i = 1, len
339  sx(i) = 42.0d0
340  100 CONTINUE
341  CALL itest1(idamax(n,sx,incx),itruec(np1))
342  ELSE
343  WRITE (nout,*) ' Shouldn''t be here in CHECK1'
344  stop
345  END IF
346  60 CONTINUE
347  IF (icase.EQ.10) THEN
348  n = 8
349  ix = 1
350  DO 120 i = 1, n
351  sxr(ix) = dvr(i)
352  ix = ix + incx
353  120 CONTINUE
354  CALL itest1(idamax(n,sxr,incx),3)
355  END IF
356  80 CONTINUE
357  RETURN
358 *
359 * End of CHECK1
360 *
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:609
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:668
subroutine itest1(ICOMP, ITRUE)
Definition: cblat1.f:743
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:71
double precision function dasum(N, DX, INCX)
DASUM
Definition: dasum.f:71
subroutine dscal(N, DA, DX, INCX)
DSCAL
Definition: dscal.f:79
real(wp) function dnrm2(n, x, incx)
DNRM2
Definition: dnrm2.f90:89
Here is the call graph for this function: