LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ check2()

subroutine check2 ( real  SFAC)

Definition at line 362 of file sblat1.f.

363 * .. Parameters ..
364  INTEGER NOUT
365  parameter(nout=6)
366 * .. Scalar Arguments ..
367  REAL SFAC
368 * .. Scalars in Common ..
369  INTEGER ICASE, INCX, INCY, N
370  LOGICAL PASS
371 * .. Local Scalars ..
372  REAL SA
373  INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
374  $ LINCX, LINCY, MX, MY
375 * .. Local Arrays ..
376  REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
377  $ DT8(7,4,4), DX1(7),
378  $ DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
379  $ SSIZE(7), STX(7), STY(7), SX(7), SY(7),
380  $ DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
381  $ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
382  $ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
383  $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
384  $ ST7B(4,4), STY0(1), SX0(1), SY0(1)
385  INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
386 * .. External Functions ..
387  REAL SDOT, SDSDOT
388  EXTERNAL sdot, sdsdot
389 * .. External Subroutines ..
390  EXTERNAL saxpy, scopy, srotm, sswap, stest, stest1
391 * .. Intrinsic Functions ..
392  INTRINSIC abs, min
393 * .. Common blocks ..
394  COMMON /combla/icase, n, incx, incy, pass
395 * .. Data statements ..
396  equivalence(dt19x(1,1,1),dt19xa(1,1,1)),(dt19x(1,1,5),
397  a dt19xb(1,1,1)),(dt19x(1,1,9),dt19xc(1,1,1)),
398  b (dt19x(1,1,13),dt19xd(1,1,1))
399  equivalence(dt19y(1,1,1),dt19ya(1,1,1)),(dt19y(1,1,5),
400  a dt19yb(1,1,1)),(dt19y(1,1,9),dt19yc(1,1,1)),
401  b (dt19y(1,1,13),dt19yd(1,1,1))
402 
403  DATA sa/0.3e0/
404  DATA incxs/1, 2, -2, -1/
405  DATA incys/1, -2, 1, -2/
406  DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
407  DATA ns/0, 1, 2, 4/
408  DATA dx1/0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.9e0, -0.3e0,
409  + -0.4e0/
410  DATA dy1/0.5e0, -0.9e0, 0.3e0, 0.7e0, -0.6e0, 0.2e0,
411  + 0.8e0/
412  DATA dt7/0.0e0, 0.30e0, 0.21e0, 0.62e0, 0.0e0,
413  + 0.30e0, -0.07e0, 0.85e0, 0.0e0, 0.30e0, -0.79e0,
414  + -0.74e0, 0.0e0, 0.30e0, 0.33e0, 1.27e0/
415  DATA st7b/ .1, .4, .31, .72, .1, .4, .03, .95,
416  + .1, .4, -.69, -.64, .1, .4, .43, 1.37/
417  DATA dt8/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
418  + 0.0e0, 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
419  + 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.0e0, 0.0e0,
420  + 0.0e0, 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.15e0,
421  + 0.94e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
422  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.68e0,
423  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
424  + 0.35e0, -0.9e0, 0.48e0, 0.0e0, 0.0e0, 0.0e0,
425  + 0.0e0, 0.38e0, -0.9e0, 0.57e0, 0.7e0, -0.75e0,
426  + 0.2e0, 0.98e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
427  + 0.0e0, 0.0e0, 0.0e0, 0.68e0, 0.0e0, 0.0e0,
428  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.35e0, -0.72e0,
429  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.38e0,
430  + -0.63e0, 0.15e0, 0.88e0, 0.0e0, 0.0e0, 0.0e0,
431  + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
432  + 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
433  + 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.0e0, 0.0e0,
434  + 0.0e0, 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.7e0,
435  + -0.75e0, 0.2e0, 1.04e0/
436  DATA dt10x/0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
437  + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
438  + 0.0e0, 0.5e0, -0.9e0, 0.0e0, 0.0e0, 0.0e0,
439  + 0.0e0, 0.0e0, 0.5e0, -0.9e0, 0.3e0, 0.7e0,
440  + 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0,
441  + 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
442  + 0.0e0, 0.0e0, 0.0e0, 0.3e0, 0.1e0, 0.5e0, 0.0e0,
443  + 0.0e0, 0.0e0, 0.0e0, 0.8e0, 0.1e0, -0.6e0,
444  + 0.8e0, 0.3e0, -0.3e0, 0.5e0, 0.6e0, 0.0e0,
445  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
446  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.9e0,
447  + 0.1e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.7e0,
448  + 0.1e0, 0.3e0, 0.8e0, -0.9e0, -0.3e0, 0.5e0,
449  + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
450  + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
451  + 0.5e0, 0.3e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
452  + 0.5e0, 0.3e0, -0.6e0, 0.8e0, 0.0e0, 0.0e0,
453  + 0.0e0/
454  DATA dt10y/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
455  + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
456  + 0.0e0, 0.6e0, 0.1e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
457  + 0.0e0, 0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.0e0,
458  + 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
459  + 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
460  + 0.0e0, 0.0e0, -0.5e0, -0.9e0, 0.6e0, 0.0e0,
461  + 0.0e0, 0.0e0, 0.0e0, -0.4e0, -0.9e0, 0.9e0,
462  + 0.7e0, -0.5e0, 0.2e0, 0.6e0, 0.5e0, 0.0e0,
463  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0,
464  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.5e0,
465  + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
466  + -0.4e0, 0.9e0, -0.5e0, 0.6e0, 0.0e0, 0.0e0,
467  + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
468  + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
469  + 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.0e0, 0.0e0,
470  + 0.0e0, 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.7e0,
471  + -0.5e0, 0.2e0, 0.8e0/
472  DATA ssize1/0.0e0, 0.3e0, 1.6e0, 3.2e0/
473  DATA ssize2/0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
474  + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
475  + 0.0e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
476  + 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
477  + 1.17e0, 1.17e0, 1.17e0/
478  DATA ssize3/ .1, .4, 1.7, 3.3 /
479 *
480 * FOR DROTM
481 *
482  DATA dpar/-2.e0, 0.e0,0.e0,0.e0,0.e0,
483  a -1.e0, 2.e0, -3.e0, -4.e0, 5.e0,
484  b 0.e0, 0.e0, 2.e0, -3.e0, 0.e0,
485  c 1.e0, 5.e0, 2.e0, 0.e0, -4.e0/
486 * TRUE X RESULTS F0R ROTATIONS DROTM
487  DATA dt19xa/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
488  a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
489  b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
490  c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
491  d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
492  e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
493  f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
494  g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
495  h .6e0, .1e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
496  i -.8e0, 3.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
497  j -.9e0, 2.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
498  k 3.5e0, -.4e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
499  l .6e0, .1e0, -.5e0, .8e0, 0.e0,0.e0,0.e0,
500  m -.8e0, 3.8e0, -2.2e0, -1.2e0, 0.e0,0.e0,0.e0,
501  n -.9e0, 2.8e0, -1.4e0, -1.3e0, 0.e0,0.e0,0.e0,
502  o 3.5e0, -.4e0, -2.2e0, 4.7e0, 0.e0,0.e0,0.e0/
503 *
504  DATA dt19xb/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
505  a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
506  b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
507  c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
508  d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
509  e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
510  f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
511  g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
512  h .6e0, .1e0, -.5e0, 0.e0,0.e0,0.e0,0.e0,
513  i 0.e0, .1e0, -3.0e0, 0.e0,0.e0,0.e0,0.e0,
514  j -.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
515  k 3.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
516  l .6e0, .1e0, -.5e0, .8e0, .9e0, -.3e0, -.4e0,
517  m -2.0e0, .1e0, 1.4e0, .8e0, .6e0, -.3e0, -2.8e0,
518  n -1.8e0, .1e0, 1.3e0, .8e0, 0.e0, -.3e0, -1.9e0,
519  o 3.8e0, .1e0, -3.1e0, .8e0, 4.8e0, -.3e0, -1.5e0 /
520 *
521  DATA dt19xc/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
522  a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
523  b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
524  c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
525  d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
526  e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
527  f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
528  g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
529  h .6e0, .1e0, -.5e0, 0.e0,0.e0,0.e0,0.e0,
530  i 4.8e0, .1e0, -3.0e0, 0.e0,0.e0,0.e0,0.e0,
531  j 3.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
532  k 2.1e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
533  l .6e0, .1e0, -.5e0, .8e0, .9e0, -.3e0, -.4e0,
534  m -1.6e0, .1e0, -2.2e0, .8e0, 5.4e0, -.3e0, -2.8e0,
535  n -1.5e0, .1e0, -1.4e0, .8e0, 3.6e0, -.3e0, -1.9e0,
536  o 3.7e0, .1e0, -2.2e0, .8e0, 3.6e0, -.3e0, -1.5e0 /
537 *
538  DATA dt19xd/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
539  a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
540  b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
541  c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
542  d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
543  e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
544  f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
545  g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
546  h .6e0, .1e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
547  i -.8e0, -1.0e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
548  j -.9e0, -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
549  k 3.5e0, .8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
550  l .6e0, .1e0, -.5e0, .8e0, 0.e0,0.e0,0.e0,
551  m -.8e0, -1.0e0, 1.4e0, -1.6e0, 0.e0,0.e0,0.e0,
552  n -.9e0, -.8e0, 1.3e0, -1.6e0, 0.e0,0.e0,0.e0,
553  o 3.5e0, .8e0, -3.1e0, 4.8e0, 0.e0,0.e0,0.e0/
554 * TRUE Y RESULTS FOR ROTATIONS DROTM
555  DATA dt19ya/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
556  a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
557  b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
558  c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
559  d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
560  e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
561  f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
562  g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
563  h .5e0, -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
564  i .7e0, -4.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
565  j 1.7e0, -.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
566  k -2.6e0, 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
567  l .5e0, -.9e0, .3e0, .7e0, 0.e0,0.e0,0.e0,
568  m .7e0, -4.8e0, 3.0e0, 1.1e0, 0.e0,0.e0,0.e0,
569  n 1.7e0, -.7e0, -.7e0, 2.3e0, 0.e0,0.e0,0.e0,
570  o -2.6e0, 3.5e0, -.7e0, -3.6e0, 0.e0,0.e0,0.e0/
571 *
572  DATA dt19yb/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
573  a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
574  b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
575  c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
576  d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
577  e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
578  f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
579  g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
580  h .5e0, -.9e0, .3e0, 0.e0,0.e0,0.e0,0.e0,
581  i 4.0e0, -.9e0, -.3e0, 0.e0,0.e0,0.e0,0.e0,
582  j -.5e0, -.9e0, 1.5e0, 0.e0,0.e0,0.e0,0.e0,
583  k -1.5e0, -.9e0, -1.8e0, 0.e0,0.e0,0.e0,0.e0,
584  l .5e0, -.9e0, .3e0, .7e0, -.6e0, .2e0, .8e0,
585  m 3.7e0, -.9e0, -1.2e0, .7e0, -1.5e0, .2e0, 2.2e0,
586  n -.3e0, -.9e0, 2.1e0, .7e0, -1.6e0, .2e0, 2.0e0,
587  o -1.6e0, -.9e0, -2.1e0, .7e0, 2.9e0, .2e0, -3.8e0 /
588 *
589  DATA dt19yc/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
590  a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
591  b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
592  c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
593  d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
594  e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
595  f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
596  g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
597  h .5e0, -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
598  i 4.0e0, -6.3e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
599  j -.5e0, .3e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
600  k -1.5e0, 3.0e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
601  l .5e0, -.9e0, .3e0, .7e0, 0.e0,0.e0,0.e0,
602  m 3.7e0, -7.2e0, 3.0e0, 1.7e0, 0.e0,0.e0,0.e0,
603  n -.3e0, .9e0, -.7e0, 1.9e0, 0.e0,0.e0,0.e0,
604  o -1.6e0, 2.7e0, -.7e0, -3.4e0, 0.e0,0.e0,0.e0/
605 *
606  DATA dt19yd/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
607  a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
608  b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
609  c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
610  d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
611  e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
612  f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
613  g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
614  h .5e0, -.9e0, .3e0, 0.e0,0.e0,0.e0,0.e0,
615  i .7e0, -.9e0, 1.2e0, 0.e0,0.e0,0.e0,0.e0,
616  j 1.7e0, -.9e0, .5e0, 0.e0,0.e0,0.e0,0.e0,
617  k -2.6e0, -.9e0, -1.3e0, 0.e0,0.e0,0.e0,0.e0,
618  l .5e0, -.9e0, .3e0, .7e0, -.6e0, .2e0, .8e0,
619  m .7e0, -.9e0, 1.2e0, .7e0, -1.5e0, .2e0, 1.6e0,
620  n 1.7e0, -.9e0, .5e0, .7e0, -1.6e0, .2e0, 2.4e0,
621  o -2.6e0, -.9e0, -1.3e0, .7e0, 2.9e0, .2e0, -4.0e0 /
622 *
623 * .. Executable Statements ..
624 *
625  DO 120 ki = 1, 4
626  incx = incxs(ki)
627  incy = incys(ki)
628  mx = abs(incx)
629  my = abs(incy)
630 *
631  DO 100 kn = 1, 4
632  n = ns(kn)
633  ksize = min(2,kn)
634  lenx = lens(kn,mx)
635  leny = lens(kn,my)
636 * .. Initialize all argument arrays ..
637  DO 20 i = 1, 7
638  sx(i) = dx1(i)
639  sy(i) = dy1(i)
640  20 CONTINUE
641 *
642  IF (icase.EQ.1) THEN
643 * .. SDOT ..
644  CALL stest1(sdot(n,sx,incx,sy,incy),dt7(kn,ki),ssize1(kn)
645  + ,sfac)
646  ELSE IF (icase.EQ.2) THEN
647 * .. SAXPY ..
648  CALL saxpy(n,sa,sx,incx,sy,incy)
649  DO 40 j = 1, leny
650  sty(j) = dt8(j,kn,ki)
651  40 CONTINUE
652  CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
653  ELSE IF (icase.EQ.5) THEN
654 * .. SCOPY ..
655  DO 60 i = 1, 7
656  sty(i) = dt10y(i,kn,ki)
657  60 CONTINUE
658  CALL scopy(n,sx,incx,sy,incy)
659  CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
660  IF (ki.EQ.1) THEN
661  sx0(1) = 42.0e0
662  sy0(1) = 43.0e0
663  IF (n.EQ.0) THEN
664  sty0(1) = sy0(1)
665  ELSE
666  sty0(1) = sx0(1)
667  END IF
668  lincx = incx
669  incx = 0
670  lincy = incy
671  incy = 0
672  CALL scopy(n,sx0,incx,sy0,incy)
673  CALL stest(1,sy0,sty0,ssize2(1,1),1.0e0)
674  incx = lincx
675  incy = lincy
676  END IF
677  ELSE IF (icase.EQ.6) THEN
678 * .. SSWAP ..
679  CALL sswap(n,sx,incx,sy,incy)
680  DO 80 i = 1, 7
681  stx(i) = dt10x(i,kn,ki)
682  sty(i) = dt10y(i,kn,ki)
683  80 CONTINUE
684  CALL stest(lenx,sx,stx,ssize2(1,1),1.0e0)
685  CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
686  ELSEIF (icase.EQ.12) THEN
687 * .. SROTM ..
688  kni=kn+4*(ki-1)
689  DO kpar=1,4
690  DO i=1,7
691  sx(i) = dx1(i)
692  sy(i) = dy1(i)
693  stx(i)= dt19x(i,kpar,kni)
694  sty(i)= dt19y(i,kpar,kni)
695  END DO
696 *
697  DO i=1,5
698  dtemp(i) = dpar(i,kpar)
699  END DO
700 *
701  DO i=1,lenx
702  ssize(i)=stx(i)
703  END DO
704 * SEE REMARK ABOVE ABOUT DT11X(1,2,7)
705 * AND DT11X(5,3,8).
706  IF ((kpar .EQ. 2) .AND. (kni .EQ. 7))
707  $ ssize(1) = 2.4e0
708  IF ((kpar .EQ. 3) .AND. (kni .EQ. 8))
709  $ ssize(5) = 1.8e0
710 *
711  CALL srotm(n,sx,incx,sy,incy,dtemp)
712  CALL stest(lenx,sx,stx,ssize,sfac)
713  CALL stest(leny,sy,sty,sty,sfac)
714  END DO
715  ELSEIF (icase.EQ.13) THEN
716 * .. SDSROT ..
717  CALL stest1 (sdsdot(n,.1,sx,incx,sy,incy),
718  $ st7b(kn,ki),ssize3(kn),sfac)
719  ELSE
720  WRITE (nout,*) ' Shouldn''t be here in CHECK2'
721  stop
722  END IF
723  100 CONTINUE
724  120 CONTINUE
725  RETURN
726 *
727 * End of CHECK2
728 *
stest
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:609
stest1
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:668
sswap
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:82
scopy
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:82
sdot
real function sdot(N, SX, INCX, SY, INCY)
SDOT
Definition: sdot.f:82
srotm
subroutine srotm(N, SX, INCX, SY, INCY, SPARAM)
SROTM
Definition: srotm.f:97
saxpy
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
Definition: saxpy.f:89
sdsdot
real function sdsdot(N, SB, SX, INCX, SY, INCY)
SDSDOT
Definition: sdsdot.f:113
Here is the call graph for this function: