523
524
525
526
527
528
529
530
531
532 INTEGER NOUT
533 parameter(nout=6)
534
535 DOUBLE PRECISION SFAC
536 INTEGER LEN
537
538 DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539
540 INTEGER ICASE, INCX, INCY, MODE, N
541 LOGICAL PASS
542
543 DOUBLE PRECISION SD
544 INTEGER I
545
546 DOUBLE PRECISION SDIFF
548
549 INTRINSIC abs
550
551 COMMON /combla/icase, n, incx, incy, mode, pass
552
553
554 DO 40 i = 1, len
555 sd = scomp(i) - strue(i)
556 IF (
sdiff(abs(ssize(i))+abs(sfac*sd),abs(ssize(i))).EQ.0.0d0)
557 + GO TO 40
558
559
560
561 IF ( .NOT. pass) GO TO 20
562
563 pass = .false.
564 WRITE (nout,99999)
565 WRITE (nout,99998)
566 20 WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
567 + strue(i), sd, ssize(i)
568 40 CONTINUE
569 RETURN
570
57199999 FORMAT (' FAIL')
57299998 FORMAT (/' CASE N INCX INCY MODE I ',
573 + ' COMP(I) TRUE(I) DIFFERENCE',
574 + ' SIZE(I)',/1x)
57599997 FORMAT (1x,i4,i3,3i5,i3,2d36.8,2d12.4)
real function sdiff(sa, sb)