LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ check2()

subroutine check2 ( double precision  SFAC)

Definition at line 342 of file zblat1.f.

343 * .. Parameters ..
344  INTEGER NOUT
345  parameter(nout=6)
346 * .. Scalar Arguments ..
347  DOUBLE PRECISION SFAC
348 * .. Scalars in Common ..
349  INTEGER ICASE, INCX, INCY, MODE, N
350  LOGICAL PASS
351 * .. Local Scalars ..
352  COMPLEX*16 CA
353  INTEGER I, J, KI, KN, KSIZE, LENX, LENY, LINCX, LINCY,
354  + MX, MY
355 * .. Local Arrays ..
356  COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
357  + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
358  + CT8(7,4,4), CTY0(1), CX(7), CX0(1), CX1(7),
359  + CY(7), CY0(1), CY1(7)
360  INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
361 * .. External Functions ..
362  COMPLEX*16 ZDOTC, ZDOTU
363  EXTERNAL zdotc, zdotu
364 * .. External Subroutines ..
365  EXTERNAL zaxpy, zcopy, zswap, ctest
366 * .. Intrinsic Functions ..
367  INTRINSIC abs, min
368 * .. Common blocks ..
369  COMMON /combla/icase, n, incx, incy, mode, pass
370 * .. Data statements ..
371  DATA ca/(0.4d0,-0.7d0)/
372  DATA incxs/1, 2, -2, -1/
373  DATA incys/1, -2, 1, -2/
374  DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
375  DATA ns/0, 1, 2, 4/
376  DATA cx1/(0.7d0,-0.8d0), (-0.4d0,-0.7d0),
377  + (-0.1d0,-0.9d0), (0.2d0,-0.8d0),
378  + (-0.9d0,-0.4d0), (0.1d0,0.4d0), (-0.6d0,0.6d0)/
379  DATA cy1/(0.6d0,-0.6d0), (-0.9d0,0.5d0),
380  + (0.7d0,-0.6d0), (0.1d0,-0.5d0), (-0.1d0,-0.2d0),
381  + (-0.5d0,-0.3d0), (0.8d0,-0.7d0)/
382  DATA ((ct8(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
383  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
384  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
385  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
386  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
387  + (0.0d0,0.0d0), (0.32d0,-1.41d0),
388  + (-1.55d0,0.5d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
389  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
390  + (0.32d0,-1.41d0), (-1.55d0,0.5d0),
391  + (0.03d0,-0.89d0), (-0.38d0,-0.96d0),
392  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
393  DATA ((ct8(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
394  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
395  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
396  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
397  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
398  + (0.0d0,0.0d0), (-0.07d0,-0.89d0),
399  + (-0.9d0,0.5d0), (0.42d0,-1.41d0), (0.0d0,0.0d0),
400  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
401  + (0.78d0,0.06d0), (-0.9d0,0.5d0),
402  + (0.06d0,-0.13d0), (0.1d0,-0.5d0),
403  + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
404  + (0.52d0,-1.51d0)/
405  DATA ((ct8(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
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.32d0,-1.41d0), (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.07d0,-0.89d0),
411  + (-1.18d0,-0.31d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
412  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
413  + (0.78d0,0.06d0), (-1.54d0,0.97d0),
414  + (0.03d0,-0.89d0), (-0.18d0,-1.31d0),
415  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
416  DATA ((ct8(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
417  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
418  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
419  + (0.32d0,-1.41d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
420  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
421  + (0.0d0,0.0d0), (0.32d0,-1.41d0), (-0.9d0,0.5d0),
422  + (0.05d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
423  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.32d0,-1.41d0),
424  + (-0.9d0,0.5d0), (0.05d0,-0.6d0), (0.1d0,-0.5d0),
425  + (-0.77d0,-0.49d0), (-0.5d0,-0.3d0),
426  + (0.32d0,-1.16d0)/
427  DATA ct7/(0.0d0,0.0d0), (-0.06d0,-0.90d0),
428  + (0.65d0,-0.47d0), (-0.34d0,-1.22d0),
429  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
430  + (-0.59d0,-1.46d0), (-1.04d0,-0.04d0),
431  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
432  + (-0.83d0,0.59d0), (0.07d0,-0.37d0),
433  + (0.0d0,0.0d0), (-0.06d0,-0.90d0),
434  + (-0.76d0,-1.15d0), (-1.33d0,-1.82d0)/
435  DATA ct6/(0.0d0,0.0d0), (0.90d0,0.06d0),
436  + (0.91d0,-0.77d0), (1.80d0,-0.10d0),
437  + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.45d0,0.74d0),
438  + (0.20d0,0.90d0), (0.0d0,0.0d0), (0.90d0,0.06d0),
439  + (-0.55d0,0.23d0), (0.83d0,-0.39d0),
440  + (0.0d0,0.0d0), (0.90d0,0.06d0), (1.04d0,0.79d0),
441  + (1.95d0,1.22d0)/
442  DATA ((ct10x(i,j,1),i=1,7),j=1,4)/(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.0d0,0.0d0),
445  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
446  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
447  + (0.0d0,0.0d0), (0.6d0,-0.6d0), (-0.9d0,0.5d0),
448  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
449  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
450  + (-0.9d0,0.5d0), (0.7d0,-0.6d0), (0.1d0,-0.5d0),
451  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
452  DATA ((ct10x(i,j,2),i=1,7),j=1,4)/(0.7d0,-0.8d0),
453  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
454  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
455  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
456  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
457  + (0.0d0,0.0d0), (0.7d0,-0.6d0), (-0.4d0,-0.7d0),
458  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
459  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.8d0,-0.7d0),
460  + (-0.4d0,-0.7d0), (-0.1d0,-0.2d0),
461  + (0.2d0,-0.8d0), (0.7d0,-0.6d0), (0.1d0,0.4d0),
462  + (0.6d0,-0.6d0)/
463  DATA ((ct10x(i,j,3),i=1,7),j=1,4)/(0.7d0,-0.8d0),
464  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
465  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
466  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
467  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
468  + (0.0d0,0.0d0), (-0.9d0,0.5d0), (-0.4d0,-0.7d0),
469  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
470  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.1d0,-0.5d0),
471  + (-0.4d0,-0.7d0), (0.7d0,-0.6d0), (0.2d0,-0.8d0),
472  + (-0.9d0,0.5d0), (0.1d0,0.4d0), (0.6d0,-0.6d0)/
473  DATA ((ct10x(i,j,4),i=1,7),j=1,4)/(0.7d0,-0.8d0),
474  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
475  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
476  + (0.6d0,-0.6d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
477  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
478  + (0.0d0,0.0d0), (0.6d0,-0.6d0), (0.7d0,-0.6d0),
479  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
480  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.6d0,-0.6d0),
481  + (0.7d0,-0.6d0), (-0.1d0,-0.2d0), (0.8d0,-0.7d0),
482  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0)/
483  DATA ((ct10y(i,j,1),i=1,7),j=1,4)/(0.6d0,-0.6d0),
484  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
485  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
486  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
487  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
488  + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.4d0,-0.7d0),
489  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
490  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
491  + (-0.4d0,-0.7d0), (-0.1d0,-0.9d0),
492  + (0.2d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
493  + (0.0d0,0.0d0)/
494  DATA ((ct10y(i,j,2),i=1,7),j=1,4)/(0.6d0,-0.6d0),
495  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
496  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
497  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
498  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
499  + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (-0.9d0,0.5d0),
500  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
501  + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
502  + (-0.9d0,0.5d0), (-0.9d0,-0.4d0), (0.1d0,-0.5d0),
503  + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
504  + (0.7d0,-0.8d0)/
505  DATA ((ct10y(i,j,3),i=1,7),j=1,4)/(0.6d0,-0.6d0),
506  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
507  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
508  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
509  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
510  + (0.0d0,0.0d0), (-0.1d0,-0.9d0), (0.7d0,-0.8d0),
511  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
512  + (0.0d0,0.0d0), (0.0d0,0.0d0), (-0.6d0,0.6d0),
513  + (-0.9d0,-0.4d0), (-0.1d0,-0.9d0),
514  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
515  + (0.0d0,0.0d0)/
516  DATA ((ct10y(i,j,4),i=1,7),j=1,4)/(0.6d0,-0.6d0),
517  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
518  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
519  + (0.7d0,-0.8d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
520  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
521  + (0.0d0,0.0d0), (0.7d0,-0.8d0), (-0.9d0,0.5d0),
522  + (-0.4d0,-0.7d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
523  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.7d0,-0.8d0),
524  + (-0.9d0,0.5d0), (-0.4d0,-0.7d0), (0.1d0,-0.5d0),
525  + (-0.1d0,-0.9d0), (-0.5d0,-0.3d0),
526  + (0.2d0,-0.8d0)/
527  DATA csize1/(0.0d0,0.0d0), (0.9d0,0.9d0),
528  + (1.63d0,1.73d0), (2.90d0,2.78d0)/
529  DATA csize3/(0.0d0,0.0d0), (0.0d0,0.0d0),
530  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
531  + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.17d0,1.17d0),
532  + (1.17d0,1.17d0), (1.17d0,1.17d0),
533  + (1.17d0,1.17d0), (1.17d0,1.17d0),
534  + (1.17d0,1.17d0), (1.17d0,1.17d0)/
535  DATA csize2/(0.0d0,0.0d0), (0.0d0,0.0d0),
536  + (0.0d0,0.0d0), (0.0d0,0.0d0), (0.0d0,0.0d0),
537  + (0.0d0,0.0d0), (0.0d0,0.0d0), (1.54d0,1.54d0),
538  + (1.54d0,1.54d0), (1.54d0,1.54d0),
539  + (1.54d0,1.54d0), (1.54d0,1.54d0),
540  + (1.54d0,1.54d0), (1.54d0,1.54d0)/
541 * .. Executable Statements ..
542  DO 60 ki = 1, 4
543  incx = incxs(ki)
544  incy = incys(ki)
545  mx = abs(incx)
546  my = abs(incy)
547 *
548  DO 40 kn = 1, 4
549  n = ns(kn)
550  ksize = min(2,kn)
551  lenx = lens(kn,mx)
552  leny = lens(kn,my)
553 * .. initialize all argument arrays ..
554  DO 20 i = 1, 7
555  cx(i) = cx1(i)
556  cy(i) = cy1(i)
557  20 CONTINUE
558  IF (icase.EQ.1) THEN
559 * .. ZDOTC ..
560  cdot(1) = zdotc(n,cx,incx,cy,incy)
561  CALL ctest(1,cdot,ct6(kn,ki),csize1(kn),sfac)
562  ELSE IF (icase.EQ.2) THEN
563 * .. ZDOTU ..
564  cdot(1) = zdotu(n,cx,incx,cy,incy)
565  CALL ctest(1,cdot,ct7(kn,ki),csize1(kn),sfac)
566  ELSE IF (icase.EQ.3) THEN
567 * .. ZAXPY ..
568  CALL zaxpy(n,ca,cx,incx,cy,incy)
569  CALL ctest(leny,cy,ct8(1,kn,ki),csize2(1,ksize),sfac)
570  ELSE IF (icase.EQ.4) THEN
571 * .. ZCOPY ..
572  CALL zcopy(n,cx,incx,cy,incy)
573  CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
574  IF (ki.EQ.1) THEN
575  cx0(1) = (42.0d0,43.0d0)
576  cy0(1) = (44.0d0,45.0d0)
577  IF (n.EQ.0) THEN
578  cty0(1) = cy0(1)
579  ELSE
580  cty0(1) = cx0(1)
581  END IF
582  lincx = incx
583  incx = 0
584  lincy = incy
585  incy = 0
586  CALL zcopy(n,cx0,incx,cy0,incy)
587  CALL ctest(1,cy0,cty0,csize3,1.0d0)
588  incx = lincx
589  incy = lincy
590  END IF
591  ELSE IF (icase.EQ.5) THEN
592 * .. ZSWAP ..
593  CALL zswap(n,cx,incx,cy,incy)
594  CALL ctest(lenx,cx,ct10x(1,kn,ki),csize3,1.0d0)
595  CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0d0)
596  ELSE
597  WRITE (nout,*) ' Shouldn''t be here in CHECK2'
598  stop
599  END IF
600 *
601  40 CONTINUE
602  60 CONTINUE
603  RETURN
604 *
605 * End of CHECK2
606 *
ctest
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)
Definition: cblat1.f:709
zswap
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:81
zdotu
complex *16 function zdotu(N, ZX, INCX, ZY, INCY)
ZDOTU
Definition: zdotu.f:83
zdotc
complex *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
Definition: zdotc.f:83
zaxpy
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
Definition: zaxpy.f:88
zcopy
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:81
Here is the call graph for this function: