LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ check2()

subroutine check2 ( real  SFAC)

Definition at line 337 of file sblat1.f.

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