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