code 34214;
real procedure RNK1MIN(N, X, G, H, FUNCT, IN, OUT);
value N;
integer N; array X, G, H, IN, OUT;
real procedure FUNCT;
begin integer I, IT, N2, CNTL, CNTE, EVL, EVLMAX;
boolean OK;
real F, F0, FMIN, MU, DG, DG0, GHG, GS, NRMDELTA, ALFA,
MACHEPS, RELTOL, ABSTOL, EPS, TOLG, ORTH, AID;
array V, DELTA, GAMMA, S, P[1:N];
MACHEPS:= IN[0]; RELTOL:= IN[1]; ABSTOL:= IN[2];
MU:= IN[3]; TOLG:= IN[4]; FMIN:= IN[5]; IT := 0;
ALFA:= IN[6]; EVLMAX:= IN[7]; ORTH:= IN[8];
N2:= N * (N + 1) // 2; CNTL:= CNTE:= 0; if ALFA > 0 then
begin INIVEC(1, N2, H, 0); INISYMD(1, N, 0, H, ALFA) end;
F:= FUNCT(N, X, G); EVL:= 1; DG:= SQRT(VECVEC(1, N, 0, G, G));
for I:= 1 step 1 until N do
DELTA[I]:= - SYMMATVEC(1, N, I, H, G);
NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA));
DG0:= VECVEC(1, N, 0, DELTA, G); OK:= DG0 < 0;
EPS:= SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL;
for IT:= IT + 1 while
(NRMDELTA > EPS or DG > TOLG or ^ OK) and EVL < EVLMAX
do
begin if ^OK then
begin array VEC[1:N,1:N], TH[1:N2], EM[0:9];
EM[0]:= MACHEPS; EM[2]:= AID:= SQRT(MACHEPS * RELTOL);
EM[4]:= ORTH; EM[6]:= AID * N; EM[8]:= 5;
CNTE:= CNTE + 1; DUPVEC(1, N2, 0, TH, H);
EIGSYM1(TH,N,N,V,VEC,EM);
for I:= 1 step 1 until N do
begin AID:= - TAMVEC(1, N, I, VEC, G);
S[I]:= AID * ABS(V[I]); V[I]:= AID * SIGN(V[I])
end
for I:= 1 step 1 until N do
begin DELTA[I]:= MATVEC(1, N, I, VEC, S);
P[I]:= MATVEC(1, N, I, VEC, V)
end;
DG0:= VECVEC(1, N, 0, DELTA, G);
NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA))
end CALCULATING GREENSTADTS DIRECTION;
DUPVEC(1, N, 0, S, X); DUPVEC(1, N, 0, V, G);
if IT > N then ALFA:= 1 else
begin if IT ^= 1 then ALFA:= ALFA / NRMDELTA else
begin ALFA:= 2 * (FMIN - F) / DG0;
if ALFA > 1 then ALFA:= 1
end
end;
ELMVEC(1, N, 0, X, DELTA, ALFA);
F0:= F; F:= FUNCT(N, X, G); EVL:= EVL +1 ;
DG:= VECVEC(1, N, 0, DELTA, G);
if IT = 1 or F0 - F < -MU * DG0 * ALFA then
begin I:= EVLMAX - EVL; CNTL:= CNTL +1 ;
LINEMIN(N, S, DELTA, NRMDELTA, ALFA, G, FUNCT, F0, F,
DG0, DG, I, false , IN); EVL:= EVL + I;
DUPVEC(1, N, 0, X, S);
end LINEMINIMIZATION;
DUPVEC(1, N, 0, GAMMA, G); ELMVEC(1, N, 0, GAMMA, V, -1);
if ^ OK then MULVEC(1, N, 0, V, P, -1);
DG:= DG - DG0; if ALFA ^= 1 then
begin MULVEC(1, N, 0, DELTA, DELTA, ALFA);
MULVEC(1, N, 0, V, V, ALFA);
NRMDELTA:= NRMDELTA * ALFA; DG:= DG * ALFA
end;
DUPVEC(1, N, 0, P, GAMMA); ELMVEC(1, N, 0, P, V, 1);
for I:= 1 step 1 until N do
V[I]:= SYMMATVEC(1, N, I, H, GAMMA);
DUPVEC(1, N, 0, S, DELTA); ELMVEC(1, N, 0, S, V, -1);
GS:= VECVEC(1, N, 0, GAMMA, S);
GHG:= VECVEC(1, N, 0, V, GAMMA);
AID:= DG / GS;
if VECVEC(1, N, 0, DELTA, P) ** 2 > VECVEC(1, N, 0, P, P)
* (ORTH * NRMDELTA) ** 2 then RNK1UPD(H, N, S, 1 / GS)
else if AID >= 0 then
FLEUPD(H, N, DELTA, V, 1 / DG, (1 + GHG / DG) / DG) else
DAVUPD(H, N, DELTA, V, 1 / DG, 1 / GHG);
for I:= 1 step 1 until N do
DELTA[I]:= -SYMMATVEC(1, N, I, H, G);
ALFA:= NRMDELTA;
NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA));
EPS:= SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL;
DG:= SQRT(VECVEC(1, N, 0, G, G));
DG0:= VECVEC(1, N, 0, DELTA, G); OK:= DG0 <= 0
end ITERATION;
OUT[0]:= NRMDELTA; OUT[1]:= DG; OUT[2]:= EVL;
OUT[3]:= CNTL; OUT[4]:= CNTE; RNK1MIN:= F
end RNK1MIN
eop