DataMuseum.dk

top - metrics - download

    Length: 1536 (0x600)
    Types: TextFile
    Names: »alglavib2«

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

TextFile

;kemlab5 1
lavibtext=set 30
lavibtext=edit alglavib
l./integer i,j,k/,r/NF/NF,NT/,l2,r/;/, IR(1:3,1:3);/
l./read(in/,r/NF/NF,NT/,l./aa(N3-5/,i/
   if j<=N-NT then begin
/,l4,i/
   end else begin
   for i:=1,2,3 do for m:=3,4,5 do
   aa(N3-m,Nj+i):= 0
end /,l./diag:/,l1,r/;/,invM;/,l2,g2/Ib/invM/
l./tridql/,l4,r/Xp(Ni+j)/Xp(Ni+j);/,l1,i/
   if NT>0 then begin
      for j:=1,2,3 do I(j):= sum(mass(k+1)*Xp(3*k+j),k,0,N-1-NT);
      for i:=1,2,3 do
      for j:=i step 1 until 3 do
        IR(i,j):= IR(j,i):=
          -sum(mass(k+1)*Xp(3*k+i)*Xp(3*k+j),k,0,N-1-NT)
          +I(i)*I(j)*invM;
      Ia:= IR(1,1); Ib:= IR(2,2); Ic:= IR(3,3);
      IR(1,1):= -Ib-Ic;
      IR(2,2):= -Ia-Ic;
      IR(3,3):= -Ia-Ib;
end /,l./array J/,l5,r/;/; if NT>0 then begin
        for i:= N3-3-NT*3 step -3 until 0 do
        p:= p + Xp(k+i)*B(rl+i) - Xp(l+i)*B(rk+i)
      end else begin
     /,l1,r/-/+/,r/+/-/,r//  /,l1,i/
      end;
/,l./J(i,j)/,l-2,i/
if NT=0 then begin
/,l./syminverse/,i/
end else begin
for i:=1 step 1 until 3 do
for j:=i step 1 until 3 do
J(i,j):= -sum(mass(k+1)*Xp(3*k+i)*X(3*k+j),k,0,N-1-NT);
Ia:= J(1,1); Ib:= J(2,2); Ic:= J(3,3);
J(1,1):= -Ib-Ic;
J(2,2):= -Ia-Ic;
J(3,3):= -Ia-Ib;
end;
/,l./-c(m)/,r/-c/c/
l3,r/ J/
   if NT=0 then J/,r/;/ else sum(J(m,i)*IR(i,k),i,1,3);/,f
i lavibtext
▶EOF◀