 ////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Search zero & minimum, adaptive integration of functions in one dimension. //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20010728 - Creation (uses CRW16) & test                                    //
// 20230503 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Search zero & minimum, adaptive integration of functions in one dimension. //
// 1. 'COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS'                        //
//     G.T.Forsythe; M.A.Malcolm;C.V Moler;Prenice-Hall,Inc.;1977             //
// 2. David M. Himmelblau ; 1972; 'Applied nonlinear programming'             //
////////////////////////////////////////////////////////////////////////////////

unit _crw_zm; // Search zero and minimum.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

type
 zmFunType = function ( x : Double; Custom : Pointer ) : Double;

 {
 ПРОЦЕДУРА ПОСКА НУЛЯ ФУНКЦИИ F(X) НА ИНТЕРВАЛЕ [AX,BX] С ТОЧНОСТЬЮ TOL.
 ИСТОЧНИК:
 ДЖ.ФОРСАЙТ МАШИННЫЕ МЕТОДЫ МАТЕМАТИЧЕСКИХ ВЫЧИСЛЕНИЙ, МИР, 1980.
 }
function FindZero( F      : zmFunType;       { ЦЕЛЕВАЯ ФУНКЦИЯ ДЛЯ ПОИСКА НУЛЯ }
                   Ax     : Double;          { НАЧАЛО ИНТЕРВАЛА ПОИСКА }
                   Bx     : Double;          { КОНЕЦ ИНТЕРВАЛА ПОИСКА }
                   Tol    : Double;          { ДОПУСК НА ТОЧНОСТЬ ПОИСКА }
                   CUSTOM : POINTER          { ПОЛЬЗОВАТЕЛЬСКИЕ ДАННЫЕ }
                        ) : Double;          { ВОЗВРАЩАЕТ ПОЛОЖЕНИЕ НУЛЯ }

 {
 ПРОЦЕДУРА ПОСКА МИНИМУМА ФУНКЦИИ F(X) НА ИНТЕРВАЛЕ [AX,BX] С ТОЧНОСТЬЮ TOL.
 ИСТОЧНИК:
 ДЖ.ФОРСАЙТ МАШИННЫЕ МЕТОДЫ МАТЕМАТИЧЕСКИХ ВЫЧИСЛЕНИЙ, МИР, 1980.
 }
function FindMin( F      : zmFunType;       { ЦЕЛЕВАЯ ФУНКЦИЯ ДЛЯ ПОИСКА МИНИМУМА }
                  Ax     : Double;          { НАЧАЛО ИНТЕРВАЛА ПОИСКА }
                  Bx     : Double;          { КОНЕЦ ИНТЕРВАЛА ПОИСКА }
                  Tol    : Double;          { ДОПУСК НА ТОЧНОСТЬ ПОИСКА }
                  CUSTOM : POINTER          { ПОЛЬЗОВАТЕЛЬСКИЕ ДАННЫЕ }
                       ) : Double;          { ВОЗВРАЩАЕТ ПОЛОЖЕНИЕ МИНИМУМА }

 {
 ПPOГPAMMA OЦEHИBAET ИHTEГPAЛ ДЛЯ FUN(X) OT A ДO B C ЗAДAHHOЙ ПOЛЬЗOBATEЛEM
 TOЧHOCTЬЮ. ABTOMATИЧECKAЯ AДAПTИBHAЯ ПPOГPAMMA, OCHOBAHHAЯ HA ФOPMYЛE
 HЬЮTOHA-KOTECA 8-ГO ПOPЯДKA.
 ИСТОЧНИК:
 ДЖ.ФОРСАЙТ МАШИННЫЕ МЕТОДЫ МАТЕМАТИЧЕСКИХ ВЫЧИСЛЕНИЙ, МИР, 1980.
 }
function QUANC8(                     { BXOДHAЯ ИHФOPMAЦИЯ }
                 FUN    : zmFunType; { ПOДИHTEГPAЛЬHАЯ ФУHKЦИЯ }
                 A      : DOUBLE;    { HИЖHИЙ ПPEДEЛ ИHTEГPИPOBAHИЯ }
                 B      : DOUBLE;    { BEPXHИЙ ПPEДEЛ, BOЗMOЖHO B<A }
                 ABSERR : DOUBLE;    { ГPAHИЦA OTHOCИTEЛЬHOЙ ПOГPEШHOCTИ>0 }
                 RELERR : DOUBLE;    { ГPAHИЦA AБCOЛЮTHOЙ ПOГPEШHOCTИ>=0 }
                                     { BЫXOДHAЯ ИHФOPMAЦИЯ }
             VAR ERREST : DOUBLE;    { OЦEHKA BEЛИЧИHЫ ДEЙCTBИTEЛЬHOЙ OШИБKИ }
             VAR NOFUN  : INTEGER;   { ЧИCЛO OБPAЩEHИЙ K FUN }
             VAR FLAG   : DOUBLE;     { ИHДИKATOP HAДEЖHOCTИ. }
                                     { ECЛИ FLAG=0, TO RESULT,BEPOЯTHO, }
                                     { B ЗAДAHHOЙ ГPAHИЦE ПOГPEШHOCTИ, }
                                     { ECЛИ FLAG=XXX.УУУ,TO XXX=ЧИCЛO }
                                     { ИHTEPBAЛOB ДЛЯ KOTOPЫX HE БЫЛO }
                                     { CXOДИMOCTИ, A 0.УУУ=ЧACTЬ OCHOBHOГO }
                                     { ИHTEPBAЛA,OCTABШAЯCЯ ДЛЯ OБPAБOTKИ }
                                     { B TOT MOMEHT, KOГДA ПPOГPAMMA }
                                     { ПPИБЛИЗИЛACЬ K ПPEДEЛЬHOMУ ЗHAЧEHИЮ }
                                     { ДЛЯ NOFUN }
                 CUSTOM : POINTER    { ПОЛЬЗОВАТЕЛЬСКИЕ ДАННЫЕ }
               ): DOUBLE;            { ВОЗВРАЩАЕТ ПPИБЛИЖEHИE K ИHTEГPAЛУ }

 {
 ФУНКЦИЯ ВОЗВРАЩАЕТ ТОЧНОСТЬ ПРЕДСТАВЛЕНИЯ ЧИСЛА DOUBLE
 }
function MachEps:double;

implementation

function FindZero( F      : zmFunType;       { ЦЕЛЕВАЯ ФУНКЦИЯ ДЛЯ ПОИСКА НУЛЯ }
                   Ax     : Double;          { НАЧАЛО ИНТЕРВАЛА ПОИСКА }
                   Bx     : Double;          { КОНЕЦ ИНТЕРВАЛА ПОИСКА }
                   Tol    : Double;          { ДОПУСК НА ТОЧНОСТЬ ПОИСКА }
                   CUSTOM : POINTER          { ПОЛЬЗОВАТЕЛЬСКИЕ ДАННЫЕ }
                        ) : Double;          { ВОЗВРАЩАЕТ ПОЛОЖЕНИЕ НУЛЯ }
label 20,30,40,50,60,70,80;
var a,b,c,d,e,eps,fa,fb,fc,tol1,xm,p,q,r,s:Double;
 function sign(a,b:Double):Double;
 begin
  if b<=0 then Result:=-abs(a) else Result:=abs(a);
 end;
begin
 eps:=MachEps;
 a:=ax;
 b:=bx;
 fa:=F(a,Custom);
 fb:=F(b,Custom);
20:
 c:=a;
 fc:=fa;
 d:=b-a;
 e:=d;
30:
 if abs(fc)>=abs(fb) then goto 40;
 a:=b;
 b:=c;
 c:=a;
 fa:=fb;
 fb:=fc;
 fc:=fa;
40:
 tol1:=2.0*eps*abs(b)+0.5*tol;
 xm:=0.5*(c-b);
 if (abs(xm)<=tol1) or (fb=0.0) then begin
  Result:=b;
  exit;
 end;
 if (abs(e)<tol1) or (abs(fa)<=abs(fb)) then goto 70;
 if a<>c then goto 50;
 s:=fb/fa;
 p:=2.0*xm*s;
 q:=1.0-s;
 goto 60;
50:
 q:=fa/fc;
 r:=fb/fc;
 s:=fb/fa;
 p:=s*(2.0*xm*q*(q-r)-(b-a)*(r-1.0));
 q:=(q-1.0)*(r-1.0)*(s-1.0);
60:
 if p>0.0 then q:=-q;
 p:=abs(p);
 if (2.0*p>=3.0*xm*q-abs(tol1*q)) or (p>=abs(e*q*0.5)) then goto 70;
 e:=d;
 d:=p/q;
 goto 80;
70:
 d:=xm;
 e:=d;
80:
 a:=b;
 fa:=fb;
 if abs(d)> tol1 then b:=b+d else b:=b+sign(tol1,xm);
 fb:=F(b,Custom);
 if fb*(fc/abs(fc))>0 then goto 20 else goto 30;
end; { FindZero }

function FindMin( F      : zmFunType;       { ЦЕЛЕВАЯ ФУНКЦИЯ ДЛЯ ПОИСКА МИНИМУМА }
                  Ax     : Double;          { НАЧАЛО ИНТЕРВАЛА ПОИСКА }
                  Bx     : Double;          { КОНЕЦ ИНТЕРВАЛА ПОИСКА }
                  Tol    : Double;          { ДОПУСК НА ТОЧНОСТЬ ПОИСКА }
                  CUSTOM : POINTER          { ПОЛЬЗОВАТЕЛЬСКИЕ ДАННЫЕ }
                       ) : Double;          { ВОЗВРАЩАЕТ ПОЛОЖЕНИЕ МИНИМУМА }
label 20,30,40,50,60,70,80;
var a,b,c,d,e,eps,xm,p,q,r,tol1,tol2,u,v,w,fu,fv,fw,fx,x:Double;
 function sign( a,b:Double):Double;
 begin
  if b<=0.0 then Result:=-abs(a) else Result:=abs(a);
 end;
BEGIN { FindMin }
 c:=0.5*(3.0-sqrt(5.0));
 eps:=sqrt(MachEps);
 a:=ax;
 b:=bx;
 v:=a+c*(b-a);
 w:=v;
 x:=v;
 e:=0.0;
 fx:=F(x,Custom);
 fv:=fx;
 fw:=fx;
 d:=0.0;
20:
 xm:=(a+b)/2.0;
 tol1:=eps*abs(x)+tol/3.0;
 tol2:=2.0*tol1;
 if abs(x-xm)<=tol2-0.5*(b-a) then begin
  Result:=x;
  exit;
 end;
 if abs(e)<=tol1 then goto 40;
 r:=(x-w)*(fx-fv);
 q:=(x-v)*(fx-fw);
 p:=(x-v)*q-(x-w)*r;
 q:=2.0*(q-r);
 if q>0.0 then p:=-p;
 q:=abs(q);
 r:=e;
 e:=d;
30:
 if abs(p)>=abs(0.5*q*r) then goto 40;
 if p<=q*(a-x) then goto 40;
 if p>=q*(b-x) then goto 40;
 d:=p/q;
 u:=x+d;
 if (u-a<tol2) or (b-u<tol2) then d:=sign(tol1,xm-x);
 goto 50;
40:
 if x>=xm then e:=a-x else e:=b-x;
 d:=c*e;
50:
 if abs(d)>=tol1 then u:=x+d else u:=x+sign(tol1,d);
 fu:=F(u,Custom);
 if fu>fx then goto 60;
 if u>=x then a:=x else b:=x;
 v:=w;
 fv:=fw;
 w:=x;
 fw:=fx;
 x:=u;
 fx:=fu;
 goto 20;
60:
 if u<x then a:=u else b:=u;
 if (fu<=fw) or (w=x) then goto 70;
 if (fu<=fv) or (v=x) or(v=w) then goto 80;
 goto 20;
70:
 v:=w;
 fv:=fw;
 w:=u;
 fw:=fu;
 goto 20;
80:
 v:=u;
 fv:=fu;
 goto 20;
end; { FindMin }

function QUANC8(                     { BXOДHAЯ ИHФOPMAЦИЯ }
                 FUN    : zmFunType; { ПOДИHTEГPAЛЬHАЯ ФУHKЦИЯ }
                 A      : DOUBLE;    { HИЖHИЙ ПPEДEЛ ИHTEГPИPOBAHИЯ }
                 B      : DOUBLE;    { BEPXHИЙ ПPEДEЛ, BOЗMOЖHO B<A }
                 ABSERR : DOUBLE;    { ГPAHИЦA OTHOCИTEЛЬHOЙ ПOГPEШHOCTИ>0 }
                 RELERR : DOUBLE;    { ГPAHИЦA AБCOЛЮTHOЙ ПOГPEШHOCTИ>=0 }
                                     { BЫXOДHAЯ ИHФOPMAЦИЯ }
             VAR ERREST : DOUBLE;    { OЦEHKA BEЛИЧИHЫ ДEЙCTBИTEЛЬHOЙ OШИБKИ }
             VAR NOFUN  : INTEGER;   { ЧИCЛO OБPAЩEHИЙ K FUN }
             VAR FLAG   : DOUBLE;     { ИHДИKATOP HAДEЖHOCTИ. }
                                     { ECЛИ FLAG=0, TO RESULT,BEPOЯTHO, }
                                     { B ЗAДAHHOЙ ГPAHИЦE ПOГPEШHOCTИ, }
                                     { ECЛИ FLAG=XXX.УУУ,TO XXX=ЧИCЛO }
                                     { ИHTEPBAЛOB ДЛЯ KOTOPЫX HE БЫЛO }
                                     { CXOДИMOCTИ, A 0.УУУ=ЧACTЬ OCHOBHOГO }
                                     { ИHTEPBAЛA,OCTABШAЯCЯ ДЛЯ OБPAБOTKИ }
                                     { B TOT MOMEHT, KOГДA ПPOГPAMMA }
                                     { ПPИБЛИЗИЛACЬ K ПPEДEЛЬHOMУ ЗHAЧEHИЮ }
                                     { ДЛЯ NOFUN }
                 CUSTOM : POINTER    { ПОЛЬЗОВАТЕЛЬСКИЕ ДАННЫЕ }
               ): DOUBLE;            { ВОЗВРАЩАЕТ ПPИБЛИЖEHИE K ИHTEГPAЛУ }
 {
 ЭМУЛЯЦИЯ ФОРТРАНОВСКОЙ ФУНКЦИИ AMAX1
 }
 FUNCTION AMAX1(A,B:DOUBLE):DOUBLE;
 BEGIN
  IF A>B THEN Result:=A ELSE Result:=B;
 END;
 {
 ДЕКЛАРАЦИИ ПЕРЕМЕННЫХ
 }
TYPE
 TWORKARRAY = PACKED RECORD
  W0,W1,W2,W3,W4,AREA,X0,F0,STONE,STEP,COR11,TEMP:DOUBLE;
  QPREV,QNOW,QDIFF,QLEFT,ESTERR,TOLERR:DOUBLE;
  QRIGHT : ARRAY[1..31] of DOUBLE;
  F      : ARRAY[1..16] of DOUBLE;
  X      : ARRAY[1..16] of DOUBLE;
  FSAVE  : ARRAY[1..8,1..30] OF DOUBLE;
  XSAVE  : ARRAY[1..8,1..30] OF DOUBLE;
  LEVMIN,LEVMAX,LEVOUT,NOMAX,NOFIN,LEV,NIM:INTEGER;
 END;
VAR
 WORKARRAY:^TWORKARRAY;
 I,J:INTEGER;
LABEL
 30,50,60,62,70,72,75,80,82,QUIT;
BEGIN
 NEW(WORKARRAY);
 WITH WORKARRAY^ DO
 TRY
  {
  ЭTAП 1 - ПPИCBOEHИE HAЧAЛЬHЫX ЗHAЧEHИЙ ПEPEMEHHЫM,HE ЗABИCЯЩИM OT ИHTEPBAЛA,
  ГEHEPИPOBAHИE KOHCTAHT.
  }
  LEVMIN:=1;
  LEVMAX:=30;
  LEVOUT:=6;
  NOMAX:=5000;
  NOFIN:=NOMAX-8*(LEVMAX-LEVOUT+(1 SHL (LEVOUT+1)));
  {
  ECЛИ NOFUN ДOCTИГAET ЗHAЧEHИЯ NOFIN, TO TPEBOГA
  }
  W0:=3956.0/14175.0;
  W1:=23552.0/14175.0;
  W2:=-3712.0/14175.0;
  W3:=41984.0/14175.0;
  W4:=-18160.0/14175.0;
  {
  ПPИCBOИTЬ HУЛEBЫE ЗHAЧEHИЯ ПEPEMEHHЫM CУMMAM
  }
  FLAG:=0.0;
  RESULT:=0.0;
  COR11:=0.0;
  ERREST:=0.0;
  AREA:=0.0;
  NOFUN:=0;
  IF(A=B) THEN GOTO QUIT;
  {
  ЭTAП 2 - ПPИCBOEHИE HAЧAЛЬHЫX ЗHAЧEHИЙ ПEPEMEHHЫM, ЗABИCЯЩИM OT ИHTEPBAЛA,
  B COOTBETCTBИИ C ПEPBЫM ИHTEPBAЛOM
  }
  LEV:=0;
  NIM:=1;
  X0:=A;
  X[16]:=B;
  QPREV:=0.0;
  F0:=FUN(X0,CUSTOM);
  STONE:=(B-A)/16.0;
  X[8]:=(X0+X[16])/2.0;
  X[4]:=(X0+X[8])/2.0;
  X[12]:=(X[8]+X[16])/2.0;
  X[2]:=(X0+X[4])/2.0;
  X[6]:=(X[4]+X[8])/2.0;
  X[10]:=(X[8]+X[12])/2.0;
  X[14]:=(X[12]+X[16])/2.0;
  FOR I:=1 TO 8 DO BEGIN
   J:=I*2;
   F[J]:=FUN(X[J],CUSTOM);
  END;
  NOFUN:=9;
  {
  ЭTAП 3 - OCHOBHЫE BЫЧИCЛEHИЯ
  TPEБУЮTCЯ QPREV,X0,X2,X4,...,X16,F0,F2,F4,...,F16.
  BЫЧИCЛЯЮTCЯ X1,X3,...,X15,F1,F3,...,F15,QLEFT,QRIGT,QNOW,QDIFF,ARREA
  }
30:
  X[1]:=(X0+X[2])/2.0;
  F[1]:=FUN(X[1],CUSTOM);
  FOR I:=1 TO 7 DO BEGIN
   J:=I*2+1;
   X[J]:=(X[J-1]+X[J+1])/2.0;
   F[J]:=FUN(X[J],CUSTOM);
  END;
  NOFUN:=NOFUN+8;
  STEP:=(X[16]-X0)/16.0;
  QLEFT:=(W0*(F0+F[8])+W1*(F[1]+F[7])+W2*(F[2]+F[6])+W3*(F[3]+F[5])+
          W4*F[4])*STEP;
  QRIGHT[LEV+1]:=(W0*(F[8]+F[16])+W1*(F[9]+F[15])+W2*(F[10]+F[14])+
                  W3*(F[11]+F[13])+W4*F[12])*STEP;
  QNOW:=QLEFT+QRIGHT[LEV+1];
  QDIFF:=QNOW-QPREV;
  AREA:=AREA+QDIFF;
  {
  ЭTAП 4 - ПPOBEPKA CXOДИMOCTИ ДЛЯ ИHTEPBAЛA
  }
  ESTERR:=ABS(QDIFF)/1023.0;
  TOLERR:=AMAX1(ABSERR,RELERR*ABS(AREA))*(STEP/STONE);
  IF(LEV<LEVMIN) THEN GOTO 50;
  IF(LEV>=LEVMAX) THEN GOTO 62;
  IF(NOFUN>NOFIN) THEN GOTO 62;
  IF(ESTERR<=TOLERR) THEN GOTO 70;
  {
  ЭTAП 5 - CXOДИMOCTИ HET, УCTAHOBИTЬ CЛEДУЮЩИЙ ИHTEPBAЛ.
  }
50:
  NIM:=2*NIM;
  LEV:=LEV+1;
  {
  ЗAПOMHИTЬ ЭЛEMEHTЫ, OTHOCЯЩИECЯ K ПPABOЙ ПOЛOBИHE ИHTEPBAЛA
  ДЛЯ БУДУЩEГO ИCПOЛЬЗOBAHИЯ.
  }
  FOR I:=1 TO 8 DO BEGIN
   FSAVE[I,LEV]:=F[I+8];
   XSAVE[I,LEV]:=X[I+8];
  END;
  {
  COБPATЬ BCE ЭЛEMEHTЫ, OTHOCЯЩИECЯ K ЛEBOЙ ПOЛOBИHE ИHTEPBAЛA
  ДЛЯ HEMEДЛEHHOГO ИCПOЛЬЗOBAHИЯ.
  }
  QPREV:=QLEFT;
  FOR I:=1 TO 8 DO BEGIN
   J:=-I;
   F[2*J+18]:=F[J+9];
   X[2*J+18]:=X[J+9];
  END;
  GOTO 30;
  {
  ЭTAП 6 - 'ПOЖAPHЫЙ' PAЗДEЛ ЧИCЛO OБPAЩEHИЙ K FUN БЛИЗKO K TOMУ,
  ЧTOБЫ ПPEBЫCИTЬ УCTAHOBЛEHHЫЙ ПPEДEЛ.
  }
60:
  NOFIN:=2*NOFIN;
  LEVMAX:=LEVOUT;
  FLAG:=FLAG+(B-X0)/(B-A);
  GOTO 70;
  {
  TEKУЩEE ПPEДEЛЬHOE ЗHAЧEHИE ГЛУБИHЫ ДEЛEHИЯ ПOПOЛAM PABHO LEVMAX
  }
62:
  FLAG:=FLAG+1.0;
  {
  ЭTAП 7 - CXOДИMOCTЬ ДЛЯ ИHTEPBAЛ A ИMEET MECTO.
  ПPИБABИTЬ OЧEPEДHЫE CЛAГAEMЫE K ПEPEMEHHЫM CУMMAM.
  }
70:
  RESULT:=RESULT+QNOW;
  ERREST:=ERREST+ESTERR;
  COR11:=COR11+QDIFF/1023.0;
  {
  УCTAHOBИTЬ CЛEДУЮЩИЙ ИHTEPBAЛ.
  }
72:
  IF(NIM=2*(NIM DIV 2)) THEN GOTO 75;
  NIM:=NIM DIV 2;
  LEV:=LEV-1;
  GOTO 72;
75:
  NIM:=NIM+1;
  IF(LEV<=0) THEN GOTO 80;
  {
  COБPATЬ ЭЛEMEHTЫ,HEOБXOДИMЫE ДЛЯ CЛEДУЮЩEГO ИHTEPBAЛA.
  }
  QPREV:=QRIGHT[LEV];
  X0:=X[16];
  F0:=F[16];
  FOR I:=1 TO 8 DO BEGIN
   F[2*I]:=FSAVE[I,LEV];
   X[2*I]:=XSAVE[I,LEV];
  END;
  GOTO 30;
  {
  ЭTAП 8 - ЗAKЛЮЧИTEЛЬHЫE OПEPAЦИИ И BЫXOД
  }
80:
  RESULT:=RESULT+COR11;
  {
  OБECПEЧИTЬ, ЧTOБЫ ЗHAЧEHИE ПEPEMEHHOЙ  ERREST
  БЫЛO HE MEHЬШE УPOBHЯ OKPУГЛEHИЙ.
  }
  IF(ERREST=0.0) THEN GOTO QUIT;
82:
  TEMP:=ABS(RESULT)+ERREST;
  IF(TEMP<>ABS(RESULT)) THEN GOTO QUIT;
  ERREST:=2.0*ERREST;
  GOTO 82;
QUIT:
 FINALLY
  DISPOSE(WORKARRAY);
 END;
END; { QUANC8 }

const
 eps : double = 0.0;

function MachEps:double;
begin
 Result:=eps;
end;

procedure FindMachEps;
var
 eps1 : double;
begin
 eps:=1.0;
 repeat
  eps:=0.5*eps;
  eps1:=1.0+eps;
 until eps1=1.0;
 eps:=eps*2.0;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_zm;
begin
 FindMachEps;
end;

procedure Free_crw_zm;
begin
end;

initialization

 Init_crw_zm;

finalization

 Free_crw_zm;

end.

//////////////
// END OF FILE
//////////////

