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

⟦f9f4ebb3e⟧ TextFile

    Length: 2304 (0x900)
    Types: TextFile
    Names: »zerostxt«

Derivation

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »zerostxt« 

TextFile

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◀