Текст подпрограммы и версий
qse1r_p.zip  		Тексты тестовых примеров
tqse1r_p.zip 

Подпрограмма:  QSE1R (модуль QSE1R_p)

Назначение

Вычисление на равномерной сетке определенного интеграла от быстроосциллирующих функций по квадратурной формуле типа Эйлера.

Математическое описание

Подпрограмма QSE1R вычисляет интеграл 

           a
           ∫ f(x) eiwx dx  =  J1M + i J2M ,     i = √-1
          b

на равномерной сетке с помощью квадратурной формулы интерполяционного типа, точной для многочленов четвертой степени с весом  e iwx .
M - число узлов интегрирования.

Использование 

procedure QSE1R(var RINT :Array of Real; A :Real; B :Real; F :Func_F1;
                R :Real; E :Real; var N :Integer; var IERR :Integer);


   Параметры
RINT - вещественный вектоp длины 2 для вычисленных значений J1 (M) и J2 (M);
A, B - заданные нижний и верхний пределы интегрирования (тип: вещественный);
F - имя вещественной подпрограммы - функции, вычисляющей подинтегральную функцию f (x);
R - заданное значение параметра  w (тип: вещественный);
E - заданная абсолютная погрешность вычисления интеграла (тип: вещественный);
N - целая переменная, задающая начальное число узлов интегрирования;
IERR - целая переменная для диагностических сообщений:
IERR = 65 - когда заданная точность не может быть достигнута при максимально возможном числе узлов (M = 1048576). 
   Версии:  нет 
   Вызываемые подпрограммы
UTQS11 - подпрограмма выдачи диагностических сообщений при работе подпрограммы QSE1R. 
   Замечания по использованию
  1. 

При E ≤ 0 происходит только один просчет при заданном значении N.

  2. 

Максимальное значение N, котоpое можно задавать, не должно превосходить 524288.

  3. 

Если интеграл вычислен с точностью E, то IERR полагается равным нулю.

  4. 

Если интеграл не может быть вычислен с точностью E, то выдается диагностическое сообщение "заданная точность не может быть достигнута".

  5.  Если IERR = 65, то N полагается равным  -1.

Пример использования 

Unit TQSE1R_p;
interface
uses
SysUtils, Math, { Delphi }
Lstruct, Lfunc, UtRes_p, FQSE1R_p, F2QSE1R_p, QSE1R_p;

function TQSE1R: String;

implementation

function TQSE1R: String;
var
IERR,N,_i :Integer;
A,B,R,E :Real;
RINT :Array [0..1] of Real;
begin
Result := '';  { результат функции }
A := -1.0;
B := 1.0;
R := -112.0;
E := 0.0000001;
N := 10;
QSE1R(RINT,A,B,FQSE1R,R,E,N,IERR);
Result := Result + #$0D#$0A;
FОR _i:=0 to 1 do
 begin
  RЕsult := Result + Format('%16.7f ',[RINT[_i]]);
  IF ( ((_i+1) mod 2)=0 )
   then Result := Result + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' IERR=']);
Result := Result + Format('%8d ',[IERR]);
Result := Result + Format('%s',[' N=']);
Result := Result + Format('%8d ',[N]) + #$0D#$0A;
N := 10;
QSE1R(RINT,-1.0,1.0,F2QSE1R,-112.0,0.0000001,N,IERR);
Result := Result + #$0D#$0A;
for _i:=0 to 1 do
 begin
  Result := Result + Format('%16.7f ',[RINT[_i]]);
  if ( ((_i+1) mod 2)=0 )
   then Result := Result + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
end;

end.

Unit FQSE1R_p;
interface
uses
SysUtils, Math, { Delphi }
Lstruct, Lfunc;

function FQSE1R(X :Real): Real;

implementation

function FQSE1R(X :Real): Real;
begin
{ Result - прототип имени функции FQSE1R на FORTRANe }
Result := IntPower(X,4);
exit;
end;

end.

Результаты:

    1.   RINT(1)  =  -0.0155869200 ;
          RINT(2)  =   0 ;
               IERR  =   0
      
    2.   RINT(1)  =   0. ;
          RINT(2)  =   0.0000739651 ;
               IERR  =   0