DataMuseum.dk

top - metrics - download

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

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦09b4e9619⟧ »thcømat« 
            └─⟦this⟧ 

TextFile

;rene moss 12-1-1973/6-8-1980

specc=algol
\f


external procedure specc(AR,n,AI);
value n; integer n; real array AR,AI;
begin
  integer i,j;
  real u,v,w,f,fm,fc,xm,ym,xr,yr,xc,yc,dx,dy,us,vs,d;
  us:=AR(0); vs:=AI(0);
  d:=abs(us)+abs(vs);
  RED:
  if n>0 then
  begin
    fm:=fc:=abs(AR(n))+abs(AI(n));
    if fm=0 then
    begin
      n:=n-1;
      goto RED
    end;
    xc:=yc:=dy:=0;
    dx:=(fm/d)**(1/n);
    ITER:
    fm:=fc+fc;
    for i:=1,2,3,4 do
    begin
      u:=-dy; dy:=dx; dx:=u;
      xr:=xc+dx; yr:=yc+dy;
      u:=us; v:=vs;
      for j:=1 step 1 until n do
      begin
          w:=AR(j)+u*xr-v*yr;
          v:=AI(j)+u*yr+v*xr;
          u:=w
        end;
        f:=abs(u)+abs(v);
        if f<fm then
        begin
          xm:=xr; ym:=yr; fm:=f
        end
      end;
      if fm<=fc then
      begin
        dx:=1.5*dx; dy:=1.5*dy;
        xc:=xm; yc:=ym; fc:=fm
      end
      else
      begin
        u:=0.4*dx-0.3*dy;
        dy:=0.4*dy+0.3*dx;
        dx:=u
      end;
      u:=abs(xc)+abs(yc);
      if u+abs(dx)+abs(dy)<>u and fc<>0 then goto ITER;
      u:=us; v:=vs;
      AR(n):=xc; AI(n):=yc;
      n:=n-1;
      for j:=1 step 1 until n do
      begin
        w:=AR(j):=AR(j)+u*xc-v*yc;
        v:=AI(j):=AI(j)+u*yc+v*xc;
        u:=w
      end;
      goto RED
    end;
  end specc
; end
▶EOF◀