940
941
942
943
944
945
946
947
948
949 INTEGER NOUT
950 REAL ZERO
951 parameter(nout=6, zero=0.0e0)
952
953 REAL SFAC
954 INTEGER LEN
955
956 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
957
958 INTEGER ICASE, INCX, INCY, N
959 LOGICAL PASS
960
961 REAL SD
962 INTEGER I
963
964 REAL SDIFF
966
967 INTRINSIC abs
968
969 COMMON /combla/icase, n, incx, incy, pass
970
971
972 DO 40 i = 1, len
973 sd = scomp(i) - strue(i)
974 IF (abs(sfac*sd) .LE. abs(ssize(i))*epsilon(zero))
975 + GO TO 40
976
977
978
979 IF ( .NOT. pass) GO TO 20
980
981 pass = .false.
982 WRITE (nout,99999)
983 WRITE (nout,99998)
984 20 WRITE (nout,99997) icase, n, incx, incy, i, scomp(i),
985 + strue(i), sd, ssize(i)
986 40 CONTINUE
987 RETURN
988
98999999 FORMAT (' FAIL')
99099998 FORMAT (/' CASE N INCX INCY I ',
991 + ' COMP(I) TRUE(I) DIFFERENCE',
992 + ' SIZE(I)',/1x)
99399997 FORMAT (1x,i4,i3,2i5,i3,2e36.8,2e12.4)
994
995
996
real function sdiff(SA, SB)