DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦22af6055d⟧ TextFile

    Length: 1536 (0x600)
    Types: TextFile
    Names: »algfjerdegr«

Derivation

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦7e928b248⟧ »algbib« 
            └─⟦this⟧ 

TextFile

;gosav
r=algol list.yes 
begin
comment fjerdegrads ligning ved Newtons metode;
integer i,k;
real a,b,c,d,e,x,dx,dx0;
array s(1:2), y(0:50), xk(1:4);
write(out,<:
a x**4 +b x**3 + c x**2 + d x + e = 0
input a, b, c, d, e: :>); forceout(out);
read(in,a,b,c,d,e);
rep:
write(out,<:
input xmin, xmax: :>); forceout(out);
read(in,dx0,dx); dx:= (dx-dx0)/50;
for i:= 0 step 1 until 50 do begin x:= dx0+dx*i;
  y(i):= (((a*x+b)*x+c)*x+d)*x+e end;
k:= 0;
for i:=1 step 1 until 50 do
if y(i-1)>0 == y(i)<=0 then begin
  k:= k+1; xk(k):= dx0+dx*(i-0.5) end;
for i:=1 step 1 until k do begin
  x:= xk(i); dx0:= x; dx:= x:= x/2;
  for x:= x+dx while abs dx<abs dx0 do begin dx0:= dx;
    dx:= -((((a*x+b)*x+c)*x+d)*x+e)/(((4*a*x+3*b)*x+2*c)*x+d) end;
  write(out,<:
x:>,<<d>,i,<: = :>,<<-d.dddddd'-dd>,x);
end;
write(out,<:
nyt interval ? (ja el. nej): :>); forceout(out);
readstring(in,s,1); if s(1) shift (-40) extract 8 = 106 then goto rep;
end;
clear fjerdegrad
rename r.fjerdegrad
r=set
permanent fjerdegrad.17
▶EOF◀