DataMuseum.dk

top - metrics - download

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

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

TextFile

;kemlab5 1
msa=set 38
permanent msa.15
msa=algol index.no

msa

Mean Square Amplitudes,           22-7-1974, GOS.

begin
integer i,j,k,l,m,Na,N3,Ni,Nj;
real q,r;  boolean closeres,sp,nl;
array head(1:12);
zone res,z(128,1,stderror);
sp:= false add 32; nl:= false add 10; closeres:= outmedium(res);
readhead(in,head,1); read(in,Na); N3:= Na*3;
i:= 1; write(res,<:<12>:>,nl,3,
        <:Mean Square Amplitudes of :>,string head(increase(i)));

begin
array X(1:N3), e(1:3), S(1:6,1:6), M(1:6);
m:= 0;
for i:=1 step 1 until Na do begin
for j:=1 step 1 until  3 do begin
   read(in,X(m+j)); repeatchar(in); readchar(in,k);
   if k=10 and j<3 then begin
      for j:=j+1 step 1 until 3 do  X(m+j):= 0 end end;
   m:= m+3
end i;
open(z,4,<:msatrack:>,0); read(in,i);
rep:
read(in,j); if i>j then begin k:=i; i:=j; j:=k end;
r:= 0; Ni:= (i-1)*3; Nj:= (j-1)*3;
for k:=1 step 1 until 3 do begin
   e(k):= q:= X(Nj+k)-X(Ni+k); r:= r + q*q end;
r:= 1/sqrt(r);
for k:= 1 step 1 until 3 do e(k):= e(k)*r;
m:= (Ni+1)*Ni//2+Ni;
setposition(z,0,m//128); m:= m mod 128 + 128;
for k:=1 step 1 until 6 do begin
for l:=1 step 1 until k do begin
   m:= m+1;
   if m>128 then begin inrec(z,128); m:= m-128 end;
   S(k,l):= z(m);
   if l=3 then m:= m+Nj-Ni-3
end;
if k=3 then begin
   getposition(z,m,l); m:= (Nj+1)*Nj//2+Ni;
   if m//128<>l then begin
      setposition(z,0,m//128); m:= m mod 128 + 128
end else m:= m mod 128 end else
m:= m+Ni
end;
for k:=1,2,3 do M(k):= S(k,k)+S(k+3,k+3)-S(k+3,k)*2;
for k:=4,5   do M(k):= S(k-2,k-3)+S(k+1,k)-S(k,k-2)-S(k+1,k-3);
M(6):= S(3,1)+S(6,4)-S(6,1)-S(4,3);
q:= sum(M(k)*e(k)**2,k,1,3)
    + (sum(M(k)*e(k-2)*e(k-3),k,4,5)+M(6)*e(1)*e(3))*2;
write(res,nl,2,<:bond :>,<<-d>,i,-j,<< -d.dddddd>,
      nl,1,<:   u =:>,sqrt(q),<:  K =:>,(sum(M(k),k,1,3)-q)*r/2);
write(res,nl,1,<:   M::>);
for k:=1 step 1 until 6 do write(res,<< -d.dddddd>,M(k));
read(in,i);
if i>0 and i<=Na then goto rep;
end;
write(res,<:<25>:>); close(res,closeres)
end;
▶EOF◀