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

⟦3ab0fa4b3⟧ TextFile

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

Derivation

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

TextFile

;kemlab5 1
lookup banddiag
if ok.no
(banddiag= set 6
banddiag=algol extbanddiag index.no)
linbend=set 40
permanent linbend.15
linbend=algol index.no
\f





linbend

begin
comment input(overskrift,g,s1,s2,vmax,matrixorden n);
integer v,l,vmax,n,i,k;
real g,s1,s2,sq1,sq2,a1,a2,b1,b2,c1,c2;
boolean sp,nl;
array head(1:12);
sp:=false add 32; nl:= false add 10;
readhead(in,head,1);
read(in,g,s1,s2,vmax,n); i:= 1;
write(out,<:<12>:>,nl,3,string head(increase(i)),nl,1,
      <:linear bender:  g =:>,<<dddd.ddddd>,g,nl,1,
      <:red. barriere, s1 = :>,s1,<:  s2 = :>,s2);
v:= (vmax+2)//2;

begin real a,b,c,w;
w:= s1+s2; a:= (s1+4*s2)/(12*w); b:= (s1+16*s2)/(24*w);
c:= (a+a-g)/8; w:= sqrt(w/2);
a1:= -1/6-a; b1:= (-6*a-g)/8; c1:= 1/6+c; a:= a*a; c:= c*c;
a2:= (-1/120+g/12+b/5-a-a-4*c)/w + w;
b2:= (b/12-a-c)/w;
c2:= (1/30-g/12-b/20+a/2+c)/w
end;

begin array h(1:n,0:if s2=0 then 1 else 2), ev(1:v), x(1:v,1:n);
comment
         h(i,0):= <v,l! h !v,l> ,
         h(i,1):= <v,l! h !v-1,l>,
         h(i,2):= <v,l! h !v-2,l> with v = i+l-1;

for l:=0 step 1 until vmax do begin
sq1:= 0;
for i:= 1 step 1 until n do begin
   v:= i+l-1; sq2:= sq1; sq1:= sqrt((v+l)*(v-l)/((v+v+1)*(v+v-1)));
   h(i,0):= ((1-g)*v*(v+1) + s1
            + (v*(v+1)+l*l-1)/((v+v-1)*(v+v+3))*s2)/2;
   h(i,1):= sq1*(g*v*v - s1)/2;
   if s2<>0 then h(i,2):= - sq1*sq2*s2/4;
end;
k:= (vmax+2-l)//2;
banddiag(n,if s2=0 then 2 else 3,1,k,ev,h,x);
write(out,nl,2,sp,5*l);
for i:=1 step 1 until k do
   write(out,<<-ddd.ddddd>,ev(i));
write(out,nl,1,sp,5*l);  v:= l;
for i:=1 step 1 until k do begin
   write(out,<<-ddd.ddddd>,
      (v+1)*(a2+b2*v*(v+2)+c2*l*l) + a1+b1*v*(v+2)+c1*l*l);
   v:= v+2 end
end l
end h
end
▶EOF◀