DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »tmin2a«

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

TextFile

\f


message min2a

min2a=algol message.no
external
real procedure min2a(f,x,y,ST,minstep,eps,dd);
value minstep,eps;
real f,x,y,minstep,eps,dd; array ST;
begin
  boolean d1,d2;
  real q,q0,q1p,q1m,q2p,q2m,x0,y0,sx,sy,s1x,s1y,s2x,s2y,a1,a2;
  integer i,im;
  q0:=f; x0:=x; y0:=y; i:=0; im:=dd;
  eps:=eps/3; minstep:=minstep*2;
  s1x:=ST(1); s2y:=ST(2); s1y:=s2x:=0;
L1:
  d1:=d2:=false;
  x:=x0+s1x; y:=y0+s1y; q1p:=f;
  if q1p<q0 then d1:=true
  else 
  begin
    x:=x0-s1x; y:=y0-s1y; q1m:=f;
    if q1m<q0 then 
    begin
      q1p:=q1m; s1x:=-s1x; s1y:=-s1y; d1:=true 
    end 
  end;
L2:
  x:=x0+s2x; y:=y0+s2y; q2p:=f;
  if q2p<q0 then d2:=true
  else 
  begin
    x:=x0-s2x; y:=y0-s2y; q2m:=f;
    if q2m<q0 then 
    begin
      q2p:=q2m; s2x:=-s2x; s2y:=-s2y; d2:=true 
    end 
  end;
  if d1 and d2 then 
  begin
    i:=0;
    a2:=2*q0-q1p-q2p; a1:=(q0-q1p)/a2; a2:=(q0-q2p)/a2;
    sx:=2*(a1*s1x+a2*s2x); sy:=2*(a1*s1y+a2*s2y);
    x:=x0+sx; y:=y0+sy; q:=f;
    q1m:=q0;
    if q<q0 then 
    begin
      q0:=q; x0:=x0+sx; y0:=y0+sy;
      x:=x0+sx; y:=y0+sy; q1p:=f;
      s2x:=a2*s1x-a1*s2x; s2y:=a2*s1y-a1*s2y; d2:=false;
      s1x:=sx; s1y:=sy; d1:=(q1p<q0); goto L2 
    end;
    sx:=sx*0.5; sy:=sy*0.5; q2m:=q1p; q1p:=q;
    x:=x0+sx; y:=y0+sy; q:=f;
    if q<q0 then 
    begin
      d2:=d1:=false; q0:=q; x0:=x0+sx; y0:=y0+sy;
      s2x:=a2*s1x-a1*s2x; s2y:=a2*s1y-a1*s2y;
      s1x:=sx;s1y:=sy; goto L2 
    end;
    if q2m>q2p then 
    begin
      q:=s1x; s1x:=s2x; s2x:=q;
      q:=s1y; s1y:=s2y; s2y:=q;
      q0:=q2p 
    end
    else q0:=q2m;
    x0:=x0+s1x; y0:=y0+s1y;
    x:=x0+s1x; y:=y0+s1y; q1p:=f;
    d1:=(q1p<q0); d2:=false; goto L2 
  end;
  if d1 or d2 then 
  begin
    i:=0;
    if d2 then 
    begin
L4:   
      q:=s1x; s1x:=s2x; s2x:=q;
      q:=s1y; s1y:=s2y; s2y:=q;
      q1p:=q2p 
    end;
L3: 
    x:=x0+2*s1x; y:=y0+2*s1y; q:=f;
    if q>q1p then 
    begin
      q1m:=q0; q0:=q1p; q1p:=q;
      d1:=d2:=false; x0:=x0+s1x; y0:=y0+s1y;
      goto L2 
    end;
    s1x:=2*s1x; s1y:=2*s1y; q1p:=q;
    goto L3 
  end;
  i:=i+1; if i>im then goto L6;
  a1:=abs(x0); a2:=abs(y0);
  if (a1+abs(s1x)=a1) and (a2+abs(s1y)=a2) then goto L5;
  d1:=(q1p=q0); d2:=(q1m=q0);
  if d1 and d2 then 
  begin
    sx:=1.5*s1x; sy:=1.5*s1y; s1x:=s2x; s1y:=s2y;
    s2x:=sx; s2y:=sy; q1p:=q2p; q1m:=q2m;
    d1:=d2:=false; goto L2 
  end;
  if d2 then 
  begin
    s1x:=-s1x; s1y:=-s1y; q1m:=q1p; q1p:=q0;
    goto L3 
  end;
  if d1 then goto L3;
L5:
  if (a1+abs(s2x)=a1) and (a2+abs(s2y)=a2) then goto L6;
  d1:=(q2p=q0); d2:=(q2m=q0);
  if d1 and d2 then 
  begin
    s2x:=1.5*s2x; s2y:=1.5*s2y; d1:=d2:=false; goto L2 
  end;
  if d2 then 
  begin
    s2x:=-s2x; s2y:=-s2y; q2m:=q2p; q2p:=q0 
  end;
  if d1 or d2 then goto L4;
L6:
  q1p:=q1p+q1m-2*q0; q2p:=q2p+q2m-2*q0;
  a1:=abs(s1x)+abs(s1y); a2:=abs(s2x)+abs(s2y);
  if (q1p+q2p)>abs(q1p+q2p+6*q0)*eps and a1+a2>minstep then 
  begin
    if q1p>=3*q2p then 
    begin
      s2x:=1.5*s2x; s2y:=1.5*s2y;
      s1x:=0.75*s1x; s1y:=0.75*s1y 
    end
    else if q2p>=3*q1p then 
    begin
      s1x:=1.5*s1x; s1y:=1.5*s1y;
      s2x:=0.75*s2x; s2y:=0.75*s2y 
    end;
    sx:=0.3*s1x+0.4*s2x; s1x:=0.4*s1x-0.3*s2x; s2x:=sx;
    sy:=0.3*s1y+0.4*s2y; s1y:=0.4*s1y-0.3*s2y; s2y:=sy;
    if abs(s1x*s2y-s2x*s1y)/a1/a2 < '-5 then 
    begin
      s2x:=s1y; s2y:=-s1x 
    end;
    goto L1 
  end;
  ST(1):=(abs(s1x)+abs(s2x))*0.5; ST(2):=(abs(s1y)+abs(s2y))*0.5;
  dd:=(q1p+q2p)*0.5;  min2a:=q0; x:=x0; y:=y0
end min2a
; end
▶EOF◀