LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ check2()

subroutine check2 ( real  SFAC)

Definition at line 333 of file cblat1.f.

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