code 33171; procedure ELIMINATION(U,LJ,UJ,LL,UL,RESIDUAL,A,B,N,DISCR,K, RATECONV,DOMEIGVAL,OUT); value LJ,UJ,LL,UL,A,B; integer LJ,UJ,LL,UL,N,K; real A,B,RATECONV,DOMEIGVAL; array U,DISCR; procedure RESIDUAL,OUT; begin real PI,AUXCOS,C,D; real procedure OPTPOL(X); value X; real X; begin real W,Y; W:= (B * COS(.5*PI/X) + DOMEIGVAL) / (B - DOMEIGVAL); if W < -1 then W:= -1; if ABS(W) <= 1 then begin Y:= ARCCOS(W); OPTPOL:= 2 * SQRT(A/B) + TAN(X*Y) * (Y - B*PI*SIN(.5*PI/X)*.5 / (X * (B-DOMEIGVAL) * SQRT(ABS(1-W*W)))) end else begin Y:= LN(W + SQRT(ABS(W*W-1))); OPTPOL:= 2 * SQRT(A/B) - TANH(X*Y) * (Y + B*PI*SIN(.5*PI/X)* .5/(X*(B-DOMEIGVAL)*SQRT(ABS(W*W-1)))) end end OPTPOL; PI:= 3.1415 92653 58979; C:= 1; if OPTPOL(C) < 0 then begin D:= .5 * PI * SQRT(ABS(B/DOMEIGVAL)); M: D:= D + D; if ZEROIN(C,D,OPTPOL(C),C*"-3) then N:= ENTIER(C+.5) else goto M; end else N:= 1; AUXCOS:= COS(.5*PI/N); RICHARDSON(U,LJ,UJ,LL,UL,true ,RESIDUAL, (2*DOMEIGVAL + B*(AUXCOS-1))/(AUXCOS+1),B,N,DISCR,K,RATECONV, DOMEIGVAL,OUT) end ELIMINATION; eop