|
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◀