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

◆ check2()

subroutine check2 ( real  SFAC)

Definition at line 342 of file cblat1.f.

343* .. Parameters ..
344 INTEGER NOUT
345 parameter(nout=6)
346* .. Scalar Arguments ..
347 REAL SFAC
348* .. Scalars in Common ..
349 INTEGER ICASE, INCX, INCY, MODE, N
350 LOGICAL PASS
351* .. Local Scalars ..
352 COMPLEX CA
353 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, LINCX, LINCY,
354 + MX, MY
355* .. Local Arrays ..
356 COMPLEX 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 CDOTC, CDOTU
363 EXTERNAL cdotc, cdotu
364* .. External Subroutines ..
365 EXTERNAL caxpy, ccopy, cswap, 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.4e0,-0.7e0)/
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.7e0,-0.8e0), (-0.4e0,-0.7e0),
377 + (-0.1e0,-0.9e0), (0.2e0,-0.8e0),
378 + (-0.9e0,-0.4e0), (0.1e0,0.4e0), (-0.6e0,0.6e0)/
379 DATA cy1/(0.6e0,-0.6e0), (-0.9e0,0.5e0),
380 + (0.7e0,-0.6e0), (0.1e0,-0.5e0), (-0.1e0,-0.2e0),
381 + (-0.5e0,-0.3e0), (0.8e0,-0.7e0)/
382 DATA ((ct8(i,j,1),i=1,7),j=1,4)/(0.6e0,-0.6e0),
383 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
384 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
385 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
386 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
387 + (0.0e0,0.0e0), (0.32e0,-1.41e0),
388 + (-1.55e0,0.5e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
389 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
390 + (0.32e0,-1.41e0), (-1.55e0,0.5e0),
391 + (0.03e0,-0.89e0), (-0.38e0,-0.96e0),
392 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
393 DATA ((ct8(i,j,2),i=1,7),j=1,4)/(0.6e0,-0.6e0),
394 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
395 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
396 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
397 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
398 + (0.0e0,0.0e0), (-0.07e0,-0.89e0),
399 + (-0.9e0,0.5e0), (0.42e0,-1.41e0), (0.0e0,0.0e0),
400 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
401 + (0.78e0,0.06e0), (-0.9e0,0.5e0),
402 + (0.06e0,-0.13e0), (0.1e0,-0.5e0),
403 + (-0.77e0,-0.49e0), (-0.5e0,-0.3e0),
404 + (0.52e0,-1.51e0)/
405 DATA ((ct8(i,j,3),i=1,7),j=1,4)/(0.6e0,-0.6e0),
406 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
407 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
408 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
409 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
410 + (0.0e0,0.0e0), (-0.07e0,-0.89e0),
411 + (-1.18e0,-0.31e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
412 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
413 + (0.78e0,0.06e0), (-1.54e0,0.97e0),
414 + (0.03e0,-0.89e0), (-0.18e0,-1.31e0),
415 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
416 DATA ((ct8(i,j,4),i=1,7),j=1,4)/(0.6e0,-0.6e0),
417 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
418 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
419 + (0.32e0,-1.41e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
420 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
421 + (0.0e0,0.0e0), (0.32e0,-1.41e0), (-0.9e0,0.5e0),
422 + (0.05e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
423 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.32e0,-1.41e0),
424 + (-0.9e0,0.5e0), (0.05e0,-0.6e0), (0.1e0,-0.5e0),
425 + (-0.77e0,-0.49e0), (-0.5e0,-0.3e0),
426 + (0.32e0,-1.16e0)/
427 DATA ct7/(0.0e0,0.0e0), (-0.06e0,-0.90e0),
428 + (0.65e0,-0.47e0), (-0.34e0,-1.22e0),
429 + (0.0e0,0.0e0), (-0.06e0,-0.90e0),
430 + (-0.59e0,-1.46e0), (-1.04e0,-0.04e0),
431 + (0.0e0,0.0e0), (-0.06e0,-0.90e0),
432 + (-0.83e0,0.59e0), (0.07e0,-0.37e0),
433 + (0.0e0,0.0e0), (-0.06e0,-0.90e0),
434 + (-0.76e0,-1.15e0), (-1.33e0,-1.82e0)/
435 DATA ct6/(0.0e0,0.0e0), (0.90e0,0.06e0),
436 + (0.91e0,-0.77e0), (1.80e0,-0.10e0),
437 + (0.0e0,0.0e0), (0.90e0,0.06e0), (1.45e0,0.74e0),
438 + (0.20e0,0.90e0), (0.0e0,0.0e0), (0.90e0,0.06e0),
439 + (-0.55e0,0.23e0), (0.83e0,-0.39e0),
440 + (0.0e0,0.0e0), (0.90e0,0.06e0), (1.04e0,0.79e0),
441 + (1.95e0,1.22e0)/
442 DATA ((ct10x(i,j,1),i=1,7),j=1,4)/(0.7e0,-0.8e0),
443 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
444 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
445 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
446 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
447 + (0.0e0,0.0e0), (0.6e0,-0.6e0), (-0.9e0,0.5e0),
448 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
449 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.6e0,-0.6e0),
450 + (-0.9e0,0.5e0), (0.7e0,-0.6e0), (0.1e0,-0.5e0),
451 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
452 DATA ((ct10x(i,j,2),i=1,7),j=1,4)/(0.7e0,-0.8e0),
453 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
454 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
455 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
456 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
457 + (0.0e0,0.0e0), (0.7e0,-0.6e0), (-0.4e0,-0.7e0),
458 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
459 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.8e0,-0.7e0),
460 + (-0.4e0,-0.7e0), (-0.1e0,-0.2e0),
461 + (0.2e0,-0.8e0), (0.7e0,-0.6e0), (0.1e0,0.4e0),
462 + (0.6e0,-0.6e0)/
463 DATA ((ct10x(i,j,3),i=1,7),j=1,4)/(0.7e0,-0.8e0),
464 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
465 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
466 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
467 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
468 + (0.0e0,0.0e0), (-0.9e0,0.5e0), (-0.4e0,-0.7e0),
469 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
470 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.1e0,-0.5e0),
471 + (-0.4e0,-0.7e0), (0.7e0,-0.6e0), (0.2e0,-0.8e0),
472 + (-0.9e0,0.5e0), (0.1e0,0.4e0), (0.6e0,-0.6e0)/
473 DATA ((ct10x(i,j,4),i=1,7),j=1,4)/(0.7e0,-0.8e0),
474 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
475 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
476 + (0.6e0,-0.6e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
477 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
478 + (0.0e0,0.0e0), (0.6e0,-0.6e0), (0.7e0,-0.6e0),
479 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
480 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.6e0,-0.6e0),
481 + (0.7e0,-0.6e0), (-0.1e0,-0.2e0), (0.8e0,-0.7e0),
482 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0)/
483 DATA ((ct10y(i,j,1),i=1,7),j=1,4)/(0.6e0,-0.6e0),
484 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
485 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
486 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
487 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
488 + (0.0e0,0.0e0), (0.7e0,-0.8e0), (-0.4e0,-0.7e0),
489 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
490 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.7e0,-0.8e0),
491 + (-0.4e0,-0.7e0), (-0.1e0,-0.9e0),
492 + (0.2e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
493 + (0.0e0,0.0e0)/
494 DATA ((ct10y(i,j,2),i=1,7),j=1,4)/(0.6e0,-0.6e0),
495 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
496 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
497 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
498 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
499 + (0.0e0,0.0e0), (-0.1e0,-0.9e0), (-0.9e0,0.5e0),
500 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
501 + (0.0e0,0.0e0), (0.0e0,0.0e0), (-0.6e0,0.6e0),
502 + (-0.9e0,0.5e0), (-0.9e0,-0.4e0), (0.1e0,-0.5e0),
503 + (-0.1e0,-0.9e0), (-0.5e0,-0.3e0),
504 + (0.7e0,-0.8e0)/
505 DATA ((ct10y(i,j,3),i=1,7),j=1,4)/(0.6e0,-0.6e0),
506 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
507 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
508 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
509 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
510 + (0.0e0,0.0e0), (-0.1e0,-0.9e0), (0.7e0,-0.8e0),
511 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
512 + (0.0e0,0.0e0), (0.0e0,0.0e0), (-0.6e0,0.6e0),
513 + (-0.9e0,-0.4e0), (-0.1e0,-0.9e0),
514 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
515 + (0.0e0,0.0e0)/
516 DATA ((ct10y(i,j,4),i=1,7),j=1,4)/(0.6e0,-0.6e0),
517 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
518 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
519 + (0.7e0,-0.8e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
520 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
521 + (0.0e0,0.0e0), (0.7e0,-0.8e0), (-0.9e0,0.5e0),
522 + (-0.4e0,-0.7e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
523 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.7e0,-0.8e0),
524 + (-0.9e0,0.5e0), (-0.4e0,-0.7e0), (0.1e0,-0.5e0),
525 + (-0.1e0,-0.9e0), (-0.5e0,-0.3e0),
526 + (0.2e0,-0.8e0)/
527 DATA csize1/(0.0e0,0.0e0), (0.9e0,0.9e0),
528 + (1.63e0,1.73e0), (2.90e0,2.78e0)/
529 DATA csize3/(0.0e0,0.0e0), (0.0e0,0.0e0),
530 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
531 + (0.0e0,0.0e0), (0.0e0,0.0e0), (1.17e0,1.17e0),
532 + (1.17e0,1.17e0), (1.17e0,1.17e0),
533 + (1.17e0,1.17e0), (1.17e0,1.17e0),
534 + (1.17e0,1.17e0), (1.17e0,1.17e0)/
535 DATA csize2/(0.0e0,0.0e0), (0.0e0,0.0e0),
536 + (0.0e0,0.0e0), (0.0e0,0.0e0), (0.0e0,0.0e0),
537 + (0.0e0,0.0e0), (0.0e0,0.0e0), (1.54e0,1.54e0),
538 + (1.54e0,1.54e0), (1.54e0,1.54e0),
539 + (1.54e0,1.54e0), (1.54e0,1.54e0),
540 + (1.54e0,1.54e0), (1.54e0,1.54e0)/
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* .. CDOTC ..
560 cdot(1) = cdotc(n,cx,incx,cy,incy)
561 CALL ctest(1,cdot,ct6(kn,ki),csize1(kn),sfac)
562 ELSE IF (icase.EQ.2) THEN
563* .. CDOTU ..
564 cdot(1) = cdotu(n,cx,incx,cy,incy)
565 CALL ctest(1,cdot,ct7(kn,ki),csize1(kn),sfac)
566 ELSE IF (icase.EQ.3) THEN
567* .. CAXPY ..
568 CALL caxpy(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* .. CCOPY ..
572 CALL ccopy(n,cx,incx,cy,incy)
573 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0e0)
574 IF (ki.EQ.1) THEN
575 cx0(1) = (42.0e0,43.0e0)
576 cy0(1) = (44.0e0,45.0e0)
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 ccopy(n,cx0,incx,cy0,incy)
587 CALL ctest(1,cy0,cty0,csize3,1.0e0)
588 incx = lincx
589 incy = lincy
590 END IF
591 ELSE IF (icase.EQ.5) THEN
592* .. CSWAP ..
593 CALL cswap(n,cx,incx,cy,incy)
594 CALL ctest(lenx,cx,ct10x(1,kn,ki),csize3,1.0e0)
595 CALL ctest(leny,cy,ct10y(1,kn,ki),csize3,1.0e0)
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
cdotc
complex function cdotc(N, CX, INCX, CY, INCY)
CDOTC
Definition: cdotc.f:83
ccopy
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:81
caxpy
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
Definition: caxpy.f:88
cswap
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
Definition: cswap.f:81
cdotu
complex function cdotu(N, CX, INCX, CY, INCY)
CDOTU
Definition: cdotu.f:83
Here is the call graph for this function:
Here is the caller graph for this function: