|
|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2304 (0x900)
Types: TextFile
Names: »zerostxt«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »zerostxt«
Rødder i 2.grads polynomium med reelle koefficienter.
begin
real a,b,c,d;
integer i;
write(out,<:<10>rødder i a*z**2+b*z+c = 0:>);
NEXTEQ:
a:=readr(<:a:>);
b:=readr(<:b:>);
c:=readr(<:c:>);
if abs a<=0.0 then
begin
if abs b<=0.0 then
write(out,<:ingen rødder:>)
else
write(out,<:kun een rod, z = :>,string exactlay(-c/b,i,a),a)
end
else
begin
d:=b*b-4*a*c;
if d<0.0 then
begin
d:=sqrt(-d)/2/abs a;
b:=-b/2/a;
a:=exactlay(b,i,b);
c:=exactlay(d,i,d);
write(out,<:z = :>,string a,b,<:+i*:>,string c,d,
<: and z = :>,string a,b,<:-i*:>,string c,d)
end imaginary roots
else
begin
d:=sqrt(d);
if b>0.0 then d:=-d;
d:=(d-b)/2/a;
write(out,<:z = :>,string exactlay(d,i,d),d,<: and z = :>,
string exactlay(c/a/d,i,b),b)
end real roots
end;
if readb(<:ny ligning:>) then goto NEXTEQ
end
Rødder i 2.grads polynomium med reelle koefficienter.
begin
real a,b,c,d;
write(out,<:<10>roots of a*z**2+b*z+c = 0:>);
NEXTEQ:
a:=readr(<:a:>);
b:=readr(<:b:>);
c:=readr(<:c:>);
if abs a<=0.0 then
begin
if abs b<=0.0 then
write(out,<:no roots:>)
else
write(out,<:only one root, z = :>,<<-d.ddd'+ddd>,-c/b)
end
else
begin
d:=b*b-4*a*c;
if d<0.0 then
begin
d:=sqrt(-d)/2/abs a;
b:=-b/2/a;
write(out,<:z = :>,<<-d.ddd'+ddd>,b,<:+i*:>,d,
<: and z = :>,b,<:-i*:>,d)
end imaginary roots
else
begin
d:=sqrt(d);
if b>0.0 then d:=-d;
d:=(d-b)/2/a;
write(out,<:z = :>,<<-d.ddd'+ddd>,d,<: and z = :>,c/a/d)
end real roots
end;
if readb(<:new equation:>) then goto NEXTEQ
end
▶EOF◀