DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »gotdo«

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

TextFile

;kemlab5 1
tdo=set 120
permanent tdo.15
tdo=algol list.yes
begin
integer i,i1,i2,it,k,l,n,ns,nm,v;
real eps,xm,xmax;
boolean nl,plot;
input:
read(in,n); if n=0 then goto stop;
plot:=n<0; n:=abs n;
read(in,xm,xmax,v,l,eps);
nl:=false add 10;
write(out,nl,3,<:n = :>,<<ddd>,n,<:   x-match = :>,<<d.d>,xm,
      <:   x-max = :>,xmax,<:   v,l = :>,
      <<dd>,v,l,<<d'-dd>,<:   eps =:>,eps,nl,1);

begin
real e,de,g0,g1,g2,h0,h1,h2,d,x,x2,y1m,y2m,p,w,w0;
array y1,y2(0:n);
e:=v+1; d:=xmax/n; nm:=xm/d; k:=l+l+1; it:=0;

iterate:
if it>0 then write(out,nl,1,<:E = :>,<<dd.dddddddd>,
                   e,<:   dE = :>,<<-d.ddd'-dd>,de);
it:=it+1; x:=d; x2:=x*x; p:=d/2;
h0:=-e/(l+1);     h1:=-e-e+x2;
g0:=0;            g1:=-k/x;
y1(0):=y2(n):=1;  y2(0):=y1(n):=0;
i:=2; i1:=ns:=1; i2:=0;

rep:
y2(i1):=(((h1*p+g0)*p+1)*y2(i2)+(h0+h1)*p*y1(i2))/
         (-(h1*p+g1)*p+1);
y1(i1):=y1(i2)+(y2(i2)+y2(i1))*p;
p:=d/12;
for i:=i step ns until nm do begin
  x:=x+d; x2:=x*x; g2:=-k/x; h2:=-e-e+x2;
  y2(i):=(((h2*p*5+g1)*p*8+1)*y2(i1)+
          ((h2*5+h1*8)*y1(i1)-h0*y1(i2)-(h2*p*5+g0)*y2(i2))*p)/
          (-(h2*p*5+g2)*p*5+1);
  y1(i):=(y2(i)*5+y2(i1)*8-y2(i2))*p+y1(i1);
  i2:=i1; i1:=i; g0:=g1; g1:=g2; h0:=h1; h1:=h2;
end;

if ns=1 then begin
  ns:=-1; i:=n-2; i1:=n-1; i2:=n; d:=-d; p:=d/2;
  x:=xmax+d; x2:=x*x;
  g0:=-k/xmax; g1:=-k/x;
  h0:=0;       h1:=-e-e+x2;
  y1m:=y1(nm); y2m:=y2(nm);
  goto rep
end;

w:=y2(nm)*y1m-y1(nm)*y2m;
d:=-d;
if it=1 then begin
  w0:=w; de:=e*0.01; e:=e+de; goto iterate
end else if it<4 or abs w<abs w0 then begin
  de:= -de*w/(w-w0); e:=e+de;
  if abs de>e*eps then begin
    w0:=w; goto iterate end
end;

p:=y1m/y1(nm);
for i:=nm step 1 until n do begin
  y1(i):= y1(i)*p; y2(i):=y2(i)*p end;

x2:=w0:=0; x:=xmax;
for i:=n-1 step -1 until 1 do begin
  x:=x-d; p:=y1(i); p:=(if l=0 then x else x**k)*p*p;
  if i=2 then p:=p*11/12;
  w0:=w0+p; x2:=x2+p*x*x;
end;
p:=p/4; w0:=w0+p; x2:=(x2+p*x*x)/w0;
write(out,nl,1,<:E = :>,<<dd.dddddddd>,e,<:   dE = :>,
      <<-d.ddd'-dd>,de,<:   it = :>,<<dd>,it,<:  <x2> = :>,
      <<d.dddddd>,x2,nl,1,<<  -d.ddd'-d>,
      <:w,y2(nm),dy2(nm),y2(xmax) = :>,
      w,y2m,y2(nm)-y2m,y2(n),nl,1);
setposition(out,0,0);

if plot then begin
setplotname(<:tek4006a:>,2);
plotform(0,17,13); plotadmini(0,xm,-1,1,0);
plotcurve(x*d,y1(x),x,0,n,1.0);
plotcurve(x*d,y2(x),x,n,0,-1.0);
plotclose;
end end;
goto input;
stop: end;
▶EOF◀