DataMuseum.dk

top - metrics - download

    Length: 9216 (0x2400)
    Types: TextFile
    Names: »gotdomat«

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

TextFile

;gosav
tdomat=set 50
permanent tdomat.15
tdomat=algol list.yes index.no
begin
comment control of tdo-matrix elements.
        P2 = p**2 + (Jz**2-1/4)/Q**2;
integer i,j,u,l;
real a,eps;
array q2,p2,q4,q6,x,d(1:10,1:10);
boolean b,sp,nl;
procedure m(a,b,c);
array a,b,c;
begin integer i,j,k;
  for i:=1 step 1 until 10 do
  for j:=1 step 1 until 10 do
    c(i,j):= sum(a(i,k)*b(k,j),k,1,10)
end;
eps:='-5; sp:=false add 32; nl:=false add 10;
write(out,<:<12>:>);

for l:=0 step 1 until 2 do begin
u:=l+1;
for i:=1 step 1 until 10 do begin
  q2(i,i):= p2(i,i):= u;
  if i>1 then begin
    p2(i,i-1):=p2(i-1,i):=a:=sqrt((u-1+l)*(u-1-l))/2;
    q2(i,i-1):=q2(i-1,i):=-a;
    for j:=i-2 step -1 until 1 do
      p2(i,j):=p2(j,i):=q2(i,j):=q2(j,i):=0
  end;
  u:=u+2
end;

comment control of Q4;
m(q2,q2,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  q4(i,i):= (u*u*3-l*l+1)/2;
  a:=d(i,i):=q4(i,i)-x(i,i);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    q4(i,i-1):=-(u-1)*2*p2(i,i-1);
    a:=d(i,i-1):=q4(i,i-1)-x(i,i-1);
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      q4(i,i-2):=p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=q4(i,i-2)-x(i,i-2);
      b:=b and (abs a<eps or i>6);
      for j:=i-3 step -1 until 1 do q4(i,j):=d(i,j):=0
  end end;
  for j:=i-1 step -1 until 1 do q4(j,i):=q4(i,j);
  u:=u+2;
end;
if b then write(out,nl,1,<:Q4 O.K.:>) else begin
  write(out,nl,1,<:Q4-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of Q6;
m(q2,q4,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  q6(i,i):= (u*u*5-l*l*3+7)*u/2;
  a:=d(i,i):=q6(i,i)-x(i,i);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    q6(i,i-1):=-((u-1)**2*5-l*l+4)*3/4*p2(i,i-1);
    a:=d(i,i-1):=q6(i,i-1)-x(i,i-1);
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      q6(i,i-2):=(u-2)*3*p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=q6(i,i-2)-x(i,i-2);
      b:=b and (abs a<eps or i>6);
      if i>3 then begin
        q6(i,i-3):=-p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3);
        a:=d(i,i-3):=q6(i,i-3)-x(i,i-3);
        b:=b and (abs a<eps or i>6);
        for j:=i-4 step -1 until 1 do q6(i,j):=d(i,j):=0
  end end end;
  for j:=i-1 step -1 until 1 do q6(j,i):=q6(i,j);
  u:=u+2;
end;
if b then write(out,nl,1,<:Q6 O.K.:>) else begin
  write(out,nl,1,<:Q6-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of Q8;
m(q2,q6,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  d(i,i):=((u*u*7-l*l*6+26)*u*u*5+(l*l-1)*(l*l-9)*3)/8;
  a:=d(i,i):=d(i,i)-x(i,i);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    d(i,i-1):=-((u-1)**2*7-l*l*3+20)*(u-1)*p2(i,i-1);
    a:=d(i,i-1):=d(i,i-1)-x(i,i-1);
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      d(i,i-2):=((u-2)**2*7-l*l+9)*p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=d(i,i-2)-x(i,i-2);
      b:=b and (abs a<eps or i>6);
      if i>3 then begin
        d(i,i-3):=-(u-3)*4*p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3);
        a:=d(i,i-3):=d(i,i-3)-x(i,i-3);
        b:=b and (abs a<eps or i>6);
        if i>4 then begin
          d(i,i-4):=p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3)*p2(i-3,i-4);
          a:=d(i,i-4):=d(i,i-4)-x(i,i-4);
          b:=b and (abs a<eps or i>6);
          for j:=i-5 step -1 until 1 do d(i,j):=0
  end end end end;
  u:=u+2;
end;
if b then write(out,nl,1,<:Q8 O.K.:>) else begin
  write(out,nl,1,<:Q8-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of (P2Q2+Q2P2)/2;
m(p2,q2,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  d(i,i):= (u*u+l*l-1)/2;
  a:=d(i,i):=d(i,i)-x(i,i);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    d(i,i-1):=0;
    a:=d(i,i-1):=d(i,i-1)-(x(i,i-1)+x(i-1,i))/2;
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      d(i,i-2):=-p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=d(i,i-2)-(x(i,i-2)+x(i-2,i))/2;
      b:=b and (abs a<eps or i>6);
      for j:=i-3 step -1 until 1 do d(i,j):=0
  end end;
  u:=u+2;
end;
if b then write(out,nl,1,<:(P2Q2+Q2P2)/2 O.K.:>) else begin
  write(out,nl,1,<:(P2Q2+Q2P2)/2-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of (P2Q4+Q4P2)/2;
m(p2,q4,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  d(i,i):= (u*u+l*l-5)*u/2;
  a:=d(i,i):=d(i,i)-x(i,i);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    d(i,i-1):=-((u-1)**2+l*l*3-12)/4*p2(i,i-1);
    a:=d(i,i-1):=d(i,i-1)-(x(i,i-1)+x(i-1,i))/2;
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      d(i,i-2):=-(u-2)*p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=d(i,i-2)-(x(i,i-2)+x(i-2,i))/2;
      b:=b and (abs a<eps or i>6);
      if i>3 then begin
        d(i,i-3):=p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3);
        a:=d(i,i-3):=d(i,i-3)-(x(i,i-3)+x(i-3,i))/2;
        b:=b and (abs a<eps or i>6);
        for j:=i-4 step -1 until 1 do d(i,j):=0
  end end end;
  u:=u+2;
end;
if b then write(out,nl,1,<:(P2Q4+Q4P2)/2 O.K.:>) else begin
  write(out,nl,1,<:(P2Q4+Q4P2)/2-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of (P2Q6+Q6P2)/2;
m(p2,q6,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  d(i,i):=((u*u*5+l*l*6-74)*u*u-(l*l-1)*(l*l-9)*3)/8;
  a:=d(i,i):=d(i,i)-x(i,i);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    d(i,i-1):=-((u-1)**2+l*l*3-28)*(u-1)/2*p2(i,i-1);
    a:=d(i,i-1):=d(i,i-1)-(x(i,i-1)+x(i-1,i))/2;
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      d(i,i-2):=-((u-2)**2-l*l+9)*p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=d(i,i-2)-(x(i,i-2)+x(i-2,i))/2;
      b:=b and (abs a<eps or i>6);
      if i>3 then begin
        d(i,i-3):=(u-3)*2*p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3);
        a:=d(i,i-3):=d(i,i-3)-(x(i,i-3)+x(i-3,i))/2;
        b:=b and (abs a<eps or i>6);
        if i>4 then begin
          d(i,i-4):=-p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3)*p2(i-3,i-4);
          a:=d(i,i-4):=d(i,i-4)-(x(i,i-4)+x(i-4,i))/2;
          b:=b and (abs a<eps or i>6);
          for j:=i-5 step -1 until 1 do d(i,j):=0
  end end end end;
  u:=u+2;
end;
if b then write(out,nl,1,<:(P2Q6+Q6P2)/2 O.K.:>) else begin
  write(out,nl,1,<:(P2Q6+Q6P2)/2-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of pQ2p;
m(p2,q2,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  d(i,i):= (u*u-l*l+3/2)/2;
  a:=d(i,i):=d(i,i)-x(i,i)+(l*l-5/4);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    d(i,i-1):=0;
    a:=d(i,i-1):=d(i,i-1)-(x(i,i-1)+x(i-1,i))/2;
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      d(i,i-2):=-p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=d(i,i-2)-(x(i,i-2)+x(i-2,i))/2;
      b:=b and (abs a<eps or i>6);
      for j:=i-3 step -1 until 1 do d(i,j):=0
  end end;
  u:=u+2;
end;
if b then write(out,nl,1,<:pQ2p O.K.:>) else begin
  write(out,nl,1,<:pQ2p-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of pQ4p;
m(p2,q4,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  d(i,i):= (u*u-l*l+15/2)*u/2;
  a:=d(i,i):=d(i,i)-x(i,i)+q2(i,i)*(l*l-25/4);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    d(i,i-1):=-((u-1)**2-l*l+13)/4*p2(i,i-1);
    a:=d(i,i-1):=d(i,i-1)-(x(i,i-1)+x(i-1,i))/2
                 +q2(i,i-1)*(l*l-25/4);
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      d(i,i-2):=-(u-2)*p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=d(i,i-2)-(x(i,i-2)+x(i-2,i))/2;
      b:=b and (abs a<eps or i>6);
      if i>3 then begin
        d(i,i-3):=p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3);
        a:=d(i,i-3):=d(i,i-3)-(x(i,i-3)+x(i-3,i))/2;
        b:=b and (abs a<eps or i>6);
        for j:=i-4 step -1 until 1 do d(i,j):=0
  end end end;
  u:=u+2;
end;
if b then write(out,nl,1,<:pQ4p O.K.:>) else begin
  write(out,nl,1,<:pQ4p-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;

comment control of pQ6p;
m(p2,q6,x);
u:=l+1; b:=true;
for i:=1 step 1 until 10 do begin
  d(i,i):=((u*u*5-l*l*6+109)*u*u+(l*l-1)*(l*l-34))/8;
  a:=d(i,i):=d(i,i)-x(i,i)+q4(i,i)*(l*l-61/4);
  b:=b and (abs a<eps or i>6);
  if i>1 then begin
    d(i,i-1):=-((u-1)**2-l*l+33)*(u-1)/2*p2(i,i-1);
    a:=d(i,i-1):=d(i,i-1)-(x(i,i-1)+x(i-1,i))/2
                 +q4(i,i-1)*(l*l-61/4);
    b:=b and (abs a<eps or i>6);
    if i>2 then begin
      d(i,i-2):=-((u-2)**2-25/4)*p2(i,i-1)*p2(i-1,i-2);
      a:=d(i,i-2):=d(i,i-2)-(x(i,i-2)+x(i-2,i))/2
                   +q4(i,i-2)*(l*l-61/4);
      b:=b and (abs a<eps or i>6);
      if i>3 then begin
        d(i,i-3):=(u-3)*2*p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3);
        a:=d(i,i-3):=d(i,i-3)-(x(i,i-3)+x(i-3,i))/2;
        b:=b and (abs a<eps or i>6);
        if i>4 then begin
          d(i,i-4):=-p2(i,i-1)*p2(i-1,i-2)*p2(i-2,i-3)*p2(i-3,i-4);
          a:=d(i,i-4):=d(i,i-4)-(x(i,i-4)+x(i-4,i))/2;
          b:=b and (abs a<eps or i>6);
          for j:=i-5 step -1 until 1 do d(i,j):=0
  end end end end;
  u:=u+2;
end;
if b then write(out,nl,1,<:pQ6p O.K.:>) else begin
  write(out,nl,1,<:pQ6p-error::>);
  writemat(out,<<  -d.dd'-d>,d,6,6)
end;
end l end;
tdomat
▶EOF◀