DataMuseum.dk

top - metrics - download

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

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

TextFile

;kemlab5 1
r=algol
\f



DIAGTEST, 16-5-77.
begin
integer i,j,k,n,m1,m2,r,s,N;
boolean sp;
sp:= false add 32;
read(in,N,n,m1,m2);
begin
real g,p,cpu1,cpu2,cpu3;
array x(1:N,1:N),H(1:N,0:n-1),ev1(1:N),
      ev2,ev3,rem1,rem2,rem3(m1:m2);
for i:=n-1 step -1 until 1 do
for j:=n-1 step -1 until i do H(i,j):= 0;
for i:=1 step 1 until N do begin
   k:= i-n; if k<1 then k:= 0;
   for j:=1 step 1 until k do x(i,j):= 0;
   for j:=k+1 step 1 until i do begin
      read(in,p); x(i,j):= H(i,i-j):= p end
end;

begin
cpu1:= systime(1,0,p);
tridql(N,ev1,x);
cpu1:= systime(1,p,p) - cpu1;
for k:=m1 step 1 until m2 do begin
g:= 0;
for i:=1 step 1 until N do begin
   p:= sum(H(i,j)*x(k,i-j),j,0,if i<n then i-1 else n-1)
     - ev1(k)*x(k,i)
     + sum(H(i+j,j)*x(k,i+j),j,1,if i+n-1>N then N-i else n-1);
   g:= g+p*p
end;
rem1(k):= sqrt(g)
end end;

begin array U(m1:m2,1:N);
cpu2:= systime(1,0,p);
if n=3 then pentadiag(N,m1,m2,ev2,H,U)
       else banddiag(N,n,m1,m2,ev2,H,U);
cpu2:= systime(1,p,p) - cpu2;
for k:=m1 step 1 until m2 do begin
g:= 0;
for i:=1 step 1 until N do begin
   p:= sum(H(i,j)*U(k,i-j),j,0,if i<n then i-1 else n-1)
     - ev2(k)*U(k,i)
     + sum(H(i+j,j)*U(k,i+j),j,1,if i+n-1>N then N-i else n-1);
   g:= g+p*p
end;
rem2(k):= sqrt(g)
end end;

comment slettet programdel:
s:= 0'  r:= n*(n+1)//2'
for i:=1 step 1 until N do begin
   k:= i-n' if k<1 then k:= 0'
   for j:=1 step 1 until k do begin
      s:= s+1' B(s):= 0 end'
   for j:=k+1 step 1 until i do begin
      s:= s+1' B(s):= H(i,i-j) end
end'
begin array x(1:N,1:N)'
cpu3:= systime(1,0,p)'
cpu3:= systime(1,p,p) - cpu3'
for k:=m1 step 1 until m2 do begin
g:= 0'
for i:=1 step 1 until N do begin
   p:= sum(H(i,j)*x(k,i-j),j,0,if i<n then i-1 else n-1)
     - ev3(k)*x(k,i)
     + sum(H(i+j,j)*x(k,i+j),j,1,if i+n-1>N then N-i else n-1)'
   g:= g+p*p
end'
rem3(k):= sqrt(g)
end end;

for k:=m1 step 1 until m2 do
write(out,<:<10>:>,<<-d.dddddddddd'-dd>,ev1(k),sp,3,rem1(k),
      <:<10>:>,ev2(k),sp,3,rem2(k),<:<10>:>);
comment <:<10>:>,ev3(k),sp,3,rem3(k),<:<10>:>);
write(out,<:<10>:>,sp,5,<<dd.dddd>,cpu1/60,sp,5,cpu2/60)
end end
rename r.diagtest
permanent diagtest.15
▶EOF◀