599
600
601
602
603
604
605
606
607
608 INTEGER NOUT
609 parameter(nout=6)
610
611 DOUBLE PRECISION SFAC
612 INTEGER LEN
613
614 DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
615
616 INTEGER ICASE, INCX, INCY, MODE, N
617 LOGICAL PASS
618
619 DOUBLE PRECISION SD
620 INTEGER I
621
622 DOUBLE PRECISION SDIFF
624
625 INTRINSIC abs
626
627 COMMON /combla/icase, n, incx, incy, mode, pass
628
629
630 DO 40 i = 1, len
631 sd = scomp(i) - strue(i)
632 IF (
sdiff(abs(ssize(i))+abs(sfac*sd),abs(ssize(i))).EQ.0.0d0)
633 + GO TO 40
634
635
636
637 IF ( .NOT. pass) GO TO 20
638
639 pass = .false.
640 WRITE (nout,99999)
641 WRITE (nout,99998)
642 20 WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
643 + strue(i), sd, ssize(i)
644 40 CONTINUE
645 RETURN
646
64799999 FORMAT (' FAIL')
64899998 FORMAT (/' CASE N INCX INCY MODE I ',
649 + ' COMP(I) TRUE(I) DIFFERENCE',
650 + ' SIZE(I)',/1x)
65199997 FORMAT (1x,i4,i3,3i5,i3,2d36.8,2d12.4)
real function sdiff(sa, sb)