Blame view
fvn_fnlib/comp1.f
1.13 KB
38581db0c git-svn-id: https... |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
subroutine comp1 (fn, dfn, xstart, xend, xincr, fname) c august 1979 edition. w. fullerton, c3, los alamos scientific lab. double precision dfn, xstart, xend, xincr, dx, df integer fname(1), fmt(23) external fn, dfn, i1mach c call s9comp (26, fmt, nwd) iwunit = i1mach(2) write (iwunit, 5) 5 format (1h1) write (iwunit, fmt) (fname(i), i=1,nwd), (fname(i), i=1,nwd) write (iwunit, 10) 10 format (1h+, 8x, 1hx, 78x, 4haerr, 8x, 4hrerr) c aerrmx = 0.0 rerrmx = 0.0 do 30 i=1,101 dx = xstart + dble(float(i-1))*xincr if (dx.gt.xend) go to 40 c x = dx f = fn(x) df = dfn(dble(x)) aerr = df - dble(f) rerr = 0.0 if (df.ne.0.0d0) rerr = abs (aerr/sngl(df)) c aerrmx = amax1 (abs(aerr), aerrmx) rerrmx = amax1 (rerr, rerrmx) df = dfn(dx) c if (mod(i,10).eq.1) write (iwunit, 20) write (iwunit, 20) x, f, df, aerr, rerr 20 format (1x, e13.5, e25.15, d40.30, 3x, 2e12.3) 30 continue c 40 write (iwunit, 50) aerrmx, rerrmx 50 format (/82x, 2e12.3) c return end |