LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ check2()

subroutine check2 ( double precision sfac)

Definition at line 347 of file zblat1.f.

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