LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ check2()

subroutine check2 ( double precision  SFAC)

Definition at line 238 of file c_dblat1.f.

238 * .. Parameters ..
239  INTEGER NOUT
240  parameter(nout=6)
241 * .. Scalar Arguments ..
242  DOUBLE PRECISION SFAC
243 * .. Scalars in Common ..
244  INTEGER ICASE, INCX, INCY, MODE, N
245  LOGICAL PASS
246 * .. Local Scalars ..
247  DOUBLE PRECISION SA
248  INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
249 * .. Local Arrays ..
250  DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
251  + DT8(7,4,4), DX1(7),
252  + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7),
253  + SX(7), SY(7)
254  INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
255 * .. External Functions ..
256  EXTERNAL ddottest
257  DOUBLE PRECISION DDOTTEST
258 * .. External Subroutines ..
259  EXTERNAL daxpytest, dcopytest, dswaptest, stest, stest1
260 * .. Intrinsic Functions ..
261  INTRINSIC abs, min
262 * .. Common blocks ..
263  COMMON /combla/icase, n, incx, incy, mode, pass
264 * .. Data statements ..
265  DATA sa/0.3d0/
266  DATA incxs/1, 2, -2, -1/
267  DATA incys/1, -2, 1, -2/
268  DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
269  DATA ns/0, 1, 2, 4/
270  DATA dx1/0.6d0, 0.1d0, -0.5d0, 0.8d0, 0.9d0, -0.3d0,
271  + -0.4d0/
272  DATA dy1/0.5d0, -0.9d0, 0.3d0, 0.7d0, -0.6d0, 0.2d0,
273  + 0.8d0/
274  DATA dt7/0.0d0, 0.30d0, 0.21d0, 0.62d0, 0.0d0,
275  + 0.30d0, -0.07d0, 0.85d0, 0.0d0, 0.30d0, -0.79d0,
276  + -0.74d0, 0.0d0, 0.30d0, 0.33d0, 1.27d0/
277  DATA dt8/0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
278  + 0.0d0, 0.68d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
279  + 0.0d0, 0.0d0, 0.68d0, -0.87d0, 0.0d0, 0.0d0,
280  + 0.0d0, 0.0d0, 0.0d0, 0.68d0, -0.87d0, 0.15d0,
281  + 0.94d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0,
282  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.68d0,
283  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
284  + 0.35d0, -0.9d0, 0.48d0, 0.0d0, 0.0d0, 0.0d0,
285  + 0.0d0, 0.38d0, -0.9d0, 0.57d0, 0.7d0, -0.75d0,
286  + 0.2d0, 0.98d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0,
287  + 0.0d0, 0.0d0, 0.0d0, 0.68d0, 0.0d0, 0.0d0,
288  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.35d0, -0.72d0,
289  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.38d0,
290  + -0.63d0, 0.15d0, 0.88d0, 0.0d0, 0.0d0, 0.0d0,
291  + 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
292  + 0.68d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
293  + 0.0d0, 0.68d0, -0.9d0, 0.33d0, 0.0d0, 0.0d0,
294  + 0.0d0, 0.0d0, 0.68d0, -0.9d0, 0.33d0, 0.7d0,
295  + -0.75d0, 0.2d0, 1.04d0/
296  DATA dt10x/0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
297  + 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
298  + 0.0d0, 0.5d0, -0.9d0, 0.0d0, 0.0d0, 0.0d0,
299  + 0.0d0, 0.0d0, 0.5d0, -0.9d0, 0.3d0, 0.7d0,
300  + 0.0d0, 0.0d0, 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0,
301  + 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0,
302  + 0.0d0, 0.0d0, 0.0d0, 0.3d0, 0.1d0, 0.5d0, 0.0d0,
303  + 0.0d0, 0.0d0, 0.0d0, 0.8d0, 0.1d0, -0.6d0,
304  + 0.8d0, 0.3d0, -0.3d0, 0.5d0, 0.6d0, 0.0d0,
305  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0,
306  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, -0.9d0,
307  + 0.1d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.7d0,
308  + 0.1d0, 0.3d0, 0.8d0, -0.9d0, -0.3d0, 0.5d0,
309  + 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
310  + 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
311  + 0.5d0, 0.3d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
312  + 0.5d0, 0.3d0, -0.6d0, 0.8d0, 0.0d0, 0.0d0,
313  + 0.0d0/
314  DATA dt10y/0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
315  + 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
316  + 0.0d0, 0.6d0, 0.1d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
317  + 0.0d0, 0.6d0, 0.1d0, -0.5d0, 0.8d0, 0.0d0,
318  + 0.0d0, 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
319  + 0.0d0, 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
320  + 0.0d0, 0.0d0, -0.5d0, -0.9d0, 0.6d0, 0.0d0,
321  + 0.0d0, 0.0d0, 0.0d0, -0.4d0, -0.9d0, 0.9d0,
322  + 0.7d0, -0.5d0, 0.2d0, 0.6d0, 0.5d0, 0.0d0,
323  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.6d0, 0.0d0,
324  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, -0.5d0,
325  + 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
326  + -0.4d0, 0.9d0, -0.5d0, 0.6d0, 0.0d0, 0.0d0,
327  + 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
328  + 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
329  + 0.0d0, 0.6d0, -0.9d0, 0.1d0, 0.0d0, 0.0d0,
330  + 0.0d0, 0.0d0, 0.6d0, -0.9d0, 0.1d0, 0.7d0,
331  + -0.5d0, 0.2d0, 0.8d0/
332  DATA ssize1/0.0d0, 0.3d0, 1.6d0, 3.2d0/
333  DATA ssize2/0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
334  + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
335  + 0.0d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
336  + 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
337  + 1.17d0, 1.17d0, 1.17d0/
338 * .. Executable Statements ..
339 *
340  DO 120 ki = 1, 4
341  incx = incxs(ki)
342  incy = incys(ki)
343  mx = abs(incx)
344  my = abs(incy)
345 *
346  DO 100 kn = 1, 4
347  n = ns(kn)
348  ksize = min(2,kn)
349  lenx = lens(kn,mx)
350  leny = lens(kn,my)
351 * .. Initialize all argument arrays ..
352  DO 20 i = 1, 7
353  sx(i) = dx1(i)
354  sy(i) = dy1(i)
355  20 CONTINUE
356 *
357  IF (icase.EQ.1) THEN
358 * .. DDOTTEST ..
359  CALL stest1(ddottest(n,sx,incx,sy,incy),dt7(kn,ki),
360  + ssize1(kn),sfac)
361  ELSE IF (icase.EQ.2) THEN
362 * .. DAXPYTEST ..
363  CALL daxpytest(n,sa,sx,incx,sy,incy)
364  DO 40 j = 1, leny
365  sty(j) = dt8(j,kn,ki)
366  40 CONTINUE
367  CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
368  ELSE IF (icase.EQ.5) THEN
369 * .. DCOPYTEST ..
370  DO 60 i = 1, 7
371  sty(i) = dt10y(i,kn,ki)
372  60 CONTINUE
373  CALL dcopytest(n,sx,incx,sy,incy)
374  CALL stest(leny,sy,sty,ssize2(1,1),1.0d0)
375  ELSE IF (icase.EQ.6) THEN
376 * .. DSWAPTEST ..
377  CALL dswaptest(n,sx,incx,sy,incy)
378  DO 80 i = 1, 7
379  stx(i) = dt10x(i,kn,ki)
380  sty(i) = dt10y(i,kn,ki)
381  80 CONTINUE
382  CALL stest(lenx,sx,stx,ssize2(1,1),1.0d0)
383  CALL stest(leny,sy,sty,ssize2(1,1),1.0d0)
384  ELSE
385  WRITE (nout,*) ' Shouldn''t be here in CHECK2'
386  stop
387  END IF
388  100 CONTINUE
389  120 CONTINUE
390  RETURN
Here is the call graph for this function:
stest
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:564
stest1
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620