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