|
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: 1536 (0x600)
Types: TextFile
Names: »gausscurvtx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦this⟧
; proj proc * page 3 31 08 77, 11.05;
; gauss_curv
; **********
if listing.yes
char 10 12 10
gauss_curv = set 1
gauss_curv = algol
external real procedure gauss_curv
__________________________________
_ (N, k_a);
value N;
long N;
array k_a;
begin
real n, at, at1, at2;
integer t;
_
comment prepare clenshaw;
_________________________
n := 2*(2.0*abs N - k_a(-1))/k_a(-1);
at1 :=
at := 0;
_
comment clenshaw;
_________________
for t := k_a(-2) step -1 until 0 do
begin
at2 := at1;
at1 := at;
at := k_a(t) + n*at1 - at2;
end;
gauss_curv := at := at - at1*n/2;
if at <0 then
begin
write(out,nl,1,<:gausscurvfejl, curv, Narg:>,nl,1,
<<__-d.dddd'-ddd>, at, N);
for t:= 0 step 1 until 6 do
write(out,nl,1,<<-d.ddd'-ddd>,k_a(t));
gausscurv := '-50;
end;
end gauss_curv;
end
if warning.yes
(mode 0.yes
message gauss_curv not ok
lookup gauss_curv)
▶EOF◀