code 34215; real procedure FLEMIN(N, X, G, H, FUNCT, IN, OUT); value N; integer N; array X, G, H, IN, OUT; real procedure FUNCT; begin integer I, IT, CNTL, EVL, EVLMAX; real F,F0,FMIN,MU,DG,DG0,NRMDELTA,ALFA,RELTOL,ABSTOL, EPS, TOLG, AID; array V, DELTA, S[1:N]; RELTOL:= IN[1]; ABSTOL:= IN[2]; MU:= IN[3]; TOLG:= IN[4]; FMIN:= IN[5]; ALFA:= IN[6]; EVLMAX:= IN[7]; OUT[4]:= 0; IT := 0; F:= FUNCT(N, X, G); EVL:= 1; CNTL:= 0;if ALFA > 0 then begin INIVEC(1, N * (N + 1) // 2, H, 0); INISYMD(1, N, 0, H, ALFA) end; for I:= 1 step 1 until N do DELTA[I]:= - SYMMATVEC(1, N, I, H, G); DG:= SQRT(VECVEC(1, N, 0, G, G)); NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA)); EPS:= SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL; DG0:= VECVEC(1, N, 0, DELTA, G); for IT := IT +1 while (NRMDELTA > EPS or DG > TOLG ) and EVL < EVLMAX do begin 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; if ALFA ^= 1 then MULVEC(1, N, 0, DELTA, DELTA, ALFA); MULVEC(1, N, 0, V, V, -1); ELMVEC(1, N, 0, V, G, 1); for I:= 1 step 1 until N do S[I]:= SYMMATVEC(1, N, I, H, V); AID:= VECVEC(1, N, 0, V, S); DG:= (DG - DG0) * ALFA; if DG > 0 then begin if DG >= AID then FLEUPD(H, N, DELTA, S, 1 / DG, (1 + AID / DG) / DG) else DAVUPD(H, N, DELTA, S, 1 / DG, 1 / AID) end UPDATING; for I:= 1 step 1 until N do DELTA[I]:= -SYMMATVEC(1, N, I, H, G); ALFA:= NRMDELTA * ALFA; 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); if DG0 > 0 then begin OUT[4]:= -1 ; goto EXIT end end ITERATION; EXIT: OUT[0]:= NRMDELTA; OUT[1]:= DG; OUT[2]:= EVL; OUT[3]:= CNTL; FLEMIN:= F end FLEMIN; eop