LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine check2 ( double precision  SFAC)

Definition at line 278 of file c_zblat1.f.

278 * .. Parameters ..
279  INTEGER nout
280  parameter (nout=6)
281 * .. Scalar Arguments ..
282  DOUBLE PRECISION sfac
283 * .. Scalars in Common ..
284  INTEGER icase, incx, incy, mode, n
285  LOGICAL pass
286 * .. Local Scalars ..
287  COMPLEX*16 ca,ztemp
288  INTEGER i, j, ki, kn, ksize, lenx, leny, mx, my
289 * .. Local Arrays ..
290  COMPLEX*16 cdot(1), csize1(4), csize2(7,2), csize3(14),
291  + ct10x(7,4,4), ct10y(7,4,4), ct6(4,4), ct7(4,4),
292  + ct8(7,4,4), cx(7), cx1(7), cy(7), cy1(7)
293  INTEGER incxs(4), incys(4), lens(4,2), ns(4)
294 * .. External Functions ..
295  EXTERNAL zdotctest, zdotutest
296 * .. External Subroutines ..
297  EXTERNAL zaxpytest, zcopytest, zswaptest, ctest
298 * .. Intrinsic Functions ..
299  INTRINSIC abs, min
300 * .. Common blocks ..
301  COMMON /combla/icase, n, incx, incy, mode, pass
302 * .. Data statements ..
303  DATA ca/(0.4d0,-0.7d0)/
304  DATA incxs/1, 2, -2, -1/
305  DATA incys/1, -2, 1, -2/
306  DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
307  DATA ns/0, 1, 2, 4/
308  DATA cx1/(0.7d0,-0.8d0), (-0.4d0,-0.7d0),
309  + (-0.1d0,-0.9d0), (0.2d0,-0.8d0),
310  + (-0.9d0,-0.4d0), (0.1d0,0.4d0), (-0.6d0,0.6d0)/
311  DATA cy1/(0.6d0,-0.6d0), (-0.9d0,0.5d0),
312  + (0.7d0,-0.6d0), (0.1d0,-0.5d0), (-0.1d0,-0.2d0),
313  + (-0.5d0,-0.3d0), (0.8d0,-0.7d0)/
314  DATA ((ct8(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
315  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
316  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
317  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
318  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
319  + (0.0d0,0.0d0), (0.32d0,-1.41d0),
320  + (-1.55d0,0.5d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
321  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
322  + (0.32d0,-1.41d0), (-1.55d0,0.5d0),
323  + (0.03d0,-0.89d0), (-0.38d0,-0.96d0),
324  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
325  DATA ((ct8(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
326  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
327  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
328  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
329  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
330  + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
331  + (-0.9d0,0.5d0), (0.42d0,-1.41d0), (0.0d0,0.0d0),
332  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
333  + (0.78d0,0.06d0), (-0.9d0,0.5d0),
334  + (0.06d0,-0.13d0), (0.1d0,-0.5d0),
335  + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
336  + (0.52d0,-1.51d0)/
337  DATA ((ct8(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
338  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
339  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
340  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
341  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
342  + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
343  + (-1.18d0,-0.31d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
344  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
345  + (0.78d0,0.06d0), (-1.54d0,0.97d0),
346  + (0.03d0,-0.89d0), (-0.18d0,-1.31d0),
347  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
348  DATA ((ct8(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
349  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
350  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
351  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
352  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
353  + (0.0d0,0.0d0), (0.32d0,-1.41d0), (-0.9d0,0.5d0),
354  + (0.05d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
355  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.32d0,-1.41d0),
356  + (-0.9d0,0.5d0), (0.05d0,-0.6d0), (0.1d0,-0.5d0),
357  + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
358  + (0.32d0,-1.16d0)/
359  DATA ct7/(0.0d0,0.0d0), (-0.06d0,-0.90d0),
360  + (0.65d0,-0.47d0), (-0.34d0,-1.22d0),
361  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
362  + (-0.59d0,-1.46d0), (-1.04d0,-0.04d0),
363  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
364  + (-0.83d0,0.59d0), (0.07d0,-0.37d0),
365  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
366  + (-0.76d0,-1.15d0), (-1.33d0,-1.82d0)/
367  DATA ct6/(0.0d0,0.0d0), (0.90d0,0.06d0),
368  + (0.91d0,-0.77d0), (1.80d0,-0.10d0),
369  + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.45d0,0.74d0),
370  + (0.20d0,0.90d0), (0.0d0,0.0d0), (0.90d0,0.06d0),
371  + (-0.55d0,0.23d0), (0.83d0,-0.39d0),
372  + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.04d0,0.79d0),
373  + (1.95d0,1.22d0)/
374  DATA ((ct10x(i,j,1),i=1,7),j=1,4)/(0.7d0,-0.8d0),
375  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
376  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
377  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
378  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
379  + (0.0d0,0.0d0), (0.6d0,-0.6d0), (-0.9d0,0.5d0),
380  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
381  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
382  + (-0.9d0,0.5d0), (0.7d0,-0.6d0), (0.1d0,-0.5d0),
383  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
384  DATA ((ct10x(i,j,2),i=1,7),j=1,4)/(0.7d0,-0.8d0),
385  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
386  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
387  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
388  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
389  + (0.0d0,0.0d0), (0.7d0,-0.6d0), (-0.4d0,-0.7d0),
390  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
391  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.8d0,-0.7d0),
392  + (-0.4d0,-0.7d0), (-0.1d0,-0.2d0),
393  + (0.2d0,-0.8d0), (0.7d0,-0.6d0), (0.1d0,0.4d0),
394  + (0.6d0,-0.6d0)/
395  DATA ((ct10x(i,j,3),i=1,7),j=1,4)/(0.7d0,-0.8d0),
396  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
397  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
398  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
399  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
400  + (0.0d0,0.0d0), (-0.9d0,0.5d0), (-0.4d0,-0.7d0),
401  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
402  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.1d0,-0.5d0),
403  + (-0.4d0,-0.7d0), (0.7d0,-0.6d0), (0.2d0,-0.8d0),
404  + (-0.9d0,0.5d0), (0.1d0,0.4d0), (0.6d0,-0.6d0)/
405  DATA ((ct10x(i,j,4),i=1,7),j=1,4)/(0.7d0,-0.8d0),
406  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
407  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
408  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
409  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
410  + (0.0d0,0.0d0), (0.6d0,-0.6d0), (0.7d0,-0.6d0),
411  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
412  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
413  + (0.7d0,-0.6d0), (-0.1d0,-0.2d0), (0.8d0,-0.7d0),
414  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
415  DATA ((ct10y(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
416  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
417  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
418  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
419  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
420  + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.4d0,-0.7d0),
421  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
422  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
423  + (-0.4d0,-0.7d0), (-0.1d0,-0.9d0),
424  + (0.2d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
425  + (0.0d0,0.0d0)/
426  DATA ((ct10y(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
427  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
428  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
429  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
430  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
431  + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (-0.9d0,0.5d0),
432  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
433  + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
434  + (-0.9d0,0.5d0), (-0.9d0,-0.4d0), (0.1d0,-0.5d0),
435  + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
436  + (0.7d0,-0.8d0)/
437  DATA ((ct10y(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
438  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
439  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
440  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
441  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
442  + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (0.7d0,-0.8d0),
443  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
444  + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
445  + (-0.9d0,-0.4d0), (-0.1d0,-0.9d0),
446  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
447  + (0.0d0,0.0d0)/
448  DATA ((ct10y(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
449  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
450  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
451  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
452  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
453  + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.9d0,0.5d0),
454  + (-0.4d0,-0.7d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
455  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
456  + (-0.9d0,0.5d0), (-0.4d0,-0.7d0), (0.1d0,-0.5d0),
457  + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
458  + (0.2d0,-0.8d0)/
459  DATA csize1/(0.0d0,0.0d0), (0.9d0,0.9d0),
460  + (1.63d0,1.73d0), (2.90d0,2.78d0)/
461  DATA csize3/(0.0d0,0.0d0), (0.0d0,0.0d0),
462  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
463  + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.17d0,1.17d0),
464  + (1.17d0,1.17d0), (1.17d0,1.17d0),
465  + (1.17d0,1.17d0), (1.17d0,1.17d0),
466  + (1.17d0,1.17d0), (1.17d0,1.17d0)/
467  DATA csize2/(0.0d0,0.0d0), (0.0d0,0.0d0),
468  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
469  + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.54d0,1.54d0),
470  + (1.54d0,1.54d0), (1.54d0,1.54d0),
471  + (1.54d0,1.54d0), (1.54d0,1.54d0),
472  + (1.54d0,1.54d0), (1.54d0,1.54d0)/
473 * .. Executable Statements ..
474  DO 60 ki = 1, 4
475  incx = incxs(ki)
476  incy = incys(ki)
477  mx = abs(incx)
478  my = abs(incy)
479 *
480  DO 40 kn = 1, 4
481  n = ns(kn)
482  ksize = min(2,kn)
483  lenx = lens(kn,mx)
484  leny = lens(kn,my)
485 * .. initialize all argument arrays ..
486  DO 20 i = 1, 7
487  cx(i) = cx1(i)
488  cy(i) = cy1(i)
489  20 CONTINUE
490  IF (icase.EQ.1) THEN
491 * .. ZDOTCTEST ..
492  CALL zdotctest(n,cx,incx,cy,incy,ztemp)
493  cdot(1) = ztemp
494  CALL ctest(1,cdot,ct6(kn,ki),csize1(kn),sfac)
495  ELSE IF (icase.EQ.2) THEN
496 * .. ZDOTUTEST ..
497  CALL zdotutest(n,cx,incx,cy,incy,ztemp)
498  cdot(1) = ztemp
499  CALL ctest(1,cdot,ct7(kn,ki),csize1(kn),sfac)
500  ELSE IF (icase.EQ.3) THEN
501 * .. ZAXPYTEST ..
502  CALL zaxpytest(n,ca,cx,incx,cy,incy)
503  CALL ctest(leny,cy,ct8(1,kn,ki),csize2(1,ksize),sfac)
504  ELSE IF (icase.EQ.4) THEN
505 * .. ZCOPYTEST ..
506  CALL zcopytest(n,cx,incx,cy,incy)
507  CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
508  ELSE IF (icase.EQ.5) THEN
509 * .. ZSWAPTEST ..
510  CALL zswaptest(n,cx,incx,cy,incy)
511  CALL ctest(lenx,cx,ct10x(1,kn,ki),csize3,1.0d0)
512  CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
513  ELSE
514  WRITE (nout,*) ' Shouldn''t be here in CHECK2'
515  stop
516  END IF
517 *
518  40 CONTINUE
519  60 CONTINUE
520  RETURN
ctest
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:655

Here is the call graph for this function: