close

Вход

Забыли?

вход по аккаунту

?

Приложение (2)

код для вставкиСкачать
program Coshi;
USES CRT,Dos,Graph,LNdif;
Label
1,11;
Type
matr6=array [1..ndim,1..7] of real;
Var
alon,alon2,memT,mem1,mem2,mem3,memIn,memOut,memArg:vectlong;
meps,tmin,tmax,t,ht,hot,hMax,dlT,delt,tf,xl1,xl2,xr1,xr2,yl1,yl2,yr1,yr2,
yt,typY,p1,p2,p3,xLef,xRit,epp,dz:real;
i,j,jj,n,pmg,chek,met,num1,num2,nk,nk0,grdr,grmd,ercd,nf1,nf2,
numText,typIn,nkSt,StopCod,nLef,nRit:integer;
ck,x0,x,rr,ri,tNet,fNet,fxi,fLag:vect;
codx,ian:invect;
ay:matr;
cc,c:char;
tex,Ibeg,hCons:boolean;
namFl:string;
hr,mt,sec,msec, hr0,mt0,sec0,msec0 : Word;
fl:text;
{$I UsesFl.pas }
{$i MatrSesT.pas }
Procedure VectB (t:real; Var b:vect);
Var
i:integer;
Begin
IF tex THEN
FOR i:=1 TO n DO b[i]:=0.0;
end { VectB };
Procedure VectFun (n:integer;
t:real;
yk:vect;
Var f:vect);
{ ГЛОБАЛЬНЫЕ ПАРАМЕТРЫ
ay - матрица системы, глобальный параметр
tex - логическая переменная,код тестового режима
numText - номер задачи }
Var
i,cd:integer;
b:vect;
begin
IF tex THEN
CASE numText OF
1: begin
MulMatrVect (n,n,n,ay,yk,f,cd);
VectB (t,b);
FOR i:=1 TO n DO f[i]:=f[i] + b[i];
end;
16: begin
f[1]:=yk[2];
f[2]:=t*yk[2] - yk[1];
f[2]:=f[2]*f[2]*dz / (t*t*t);
end;
end { case };
IF not tex THEN VectFunUs (n,numText,ay,yk,f);
end { VectFun };
Procedure TextFun (n:integer;
tt:real;
Var xText:vect);
{ НАЗНАЧЕНИЕ
Вычислять точное решение текстовой задачи Коши для ОДУ }
{ ВХОДНЫЕ ПАРАМЕТРЫ
n - размерность задачи;
tt - текущее значение аргумента;
ck - вектор коэффициентов точного решения - глобальный параметр;
{ ВЫХОДНЫЕ ПАРАМЕТРЫ
xText - вектор решения }
Var
c1,c2:real;
Begin
CASE numText OF
1: begin
xText[1]:=Exp(-tt)*Sin(tt);
xText[2]:=Exp(-tt)*(Cos(tt) - Sin(tt) );
end;
16: begin
xText[1]:=tt* Ln (tt/(tt+0.1)) / dz;
xText[2]:= Ln (tt/(tt+0.1)) / dz + 0.1/(dz*(tt+0.1));
end;
end { case };
end; { textFun }
Procedure Jacfd (n:integer;
x,F,s:vect;
t,teta:real;
Var JC:matr);
{ НАЗНАЧЕНИЕ.
Вычислять аппроксимацию по разностям вперед для матрицы
Якоби векторной функции F(x) в точке x. }
{ ВХОДНЫЕ ПАРАМЕТРЫ.
n - размерность системы уравнений, задаваемой F;
x - вектор аргументов функции F;
F - вектор функций,задающих систему уравнений;
s - вектор величин,обратных к типичным значениям x[i];
t - текущее значение независимого аргумента;
teta - относительная точность вычисления F(x). }
{ ВЫХОДНЫЕ ПАРАМЕТРЫ.
JC - аппроксимация матрицы Якоби. }
{ ТРЕБУЕМЫЕ ПОДПРОГРАММЫ.
VectFun (n,t,x,F) - процедура,вычисляющая вектор F в заданной
точке "x". }
var
F1:vect;
temp,h,teta2,aa,bb:real;
j,i:integer;
begin
teta2:=SQRT (teta);
FOR j:=1 TO n DO
begin
{ вычислить j-й столбец матрицы JC }
aa:=abs(x[j]); bb:=1.0/s[j];
IF aa>bb THEN temp:=aa ELSE temp:=bb;
IF aa>1.0E-38 THEN h:=teta2*temp*x[j]/aa
ELSE h:=teta2*temp;
temp:=x[j];
x[j]:=x[j]+h;
h:=x[j]-temp;
{ эта строка немного уменьшает ошибки машинной
арифметики в представлении h }
VectFun (n,t,x,F1);
FOR i:=1 TO n DO
JC[i,j]:=(F1[i]-F[i])/h;
{ восстановить значение x[j] }
x[j]:=temp;
end;
end { JACFD };
Procedure RK2h (n:integer;
h,t:real;
yk:vect;
Var yk1:vect;
Var stopCod:integer);
{ НАЗНАЧЕНИЕ
Одношаговый интегратор для системы ОДУ
по методу Рунге-Кутты 2-го порядка }
{ ВХОДНЫЕ ПАРАМЕТРЫ
n - порядок системы;
h - шаг интегрирования;
t - текущее значение аргумента;
yk - решение в точке t-h;
{ ВЫХОДНЫЕ ПАРАМЕТРЫ
yk1 - решение в точке t;
StopCod - код выхода из процедуры;
StopCod=1 - нормальное завершение
StopCod=2 - выявлена угроза неустойчивости; }
Var
k1,k2,kv:vect;
i:integer;
Begin
stopCod:=1;
VectFun (n,t-h,yk,k1);
FOR i:=1 TO n DO kv[i]:=yk[i]+0.75*h*k1[i];
VectFun (n,t-0.25*h,kv,k2);
FOR i:=1 TO N DO yk1[i]:=yk[i]+h*(k1[i]+2.0*k2[i])/3.0;
{ проверка на потерю устойчивости }
FOR i:=1 TO n DO
IF abs(yk1[i]) > (1.0/meps) THEN StopCod:=2;
End; { rk2h }
Procedure RK3h (n:integer;
h,t:real;
yk:vect;
Var yk1:vect;
Var stopCod:integer);
{ НАЗНАЧЕНИЕ
Одношаговый интегратор для системы ОДУ
по методу Рунге-Кутты 3-го порядка }
{ ВХОДНЫЕ ПАРАМЕТРЫ
n - порядок системы;
h - шаг интегрирования;
t - текущее значение аргумента;
yk - решение в точке t-h;
{ ВЫХОДНЫЕ ПАРАМЕТРЫ
yk1 - решение в точке t;
StopCod - код выхода из процедуры;
StopCod=1 - нормальное завершение
StopCod=2 - выявлена угроза неустойчивости; }
Var
k1,k2,k3,kv:vect;
i:integer;
begin
stopCod:=1;
VectFun (n,t-h,yk,k1);
FOR i:=1 TO n DO kv[i]:=yk[i]+0.5*h*k1[i];
VectFun (n,t-0.5*h,kv,k2);
FOR i:=1 TO n DO kv[i]:=yk[i] - h*k1[i] + 2.0*h*k2[i];
VectFun (n,t,kv,k3);
FOR i:=1 TO N DO yk1[i]:=yk[i] + h*(k1[i] + 4.0*k2[i] + k3[i])/6.0;
{ проверка на потерю устойчивости }
FOR i:=1 TO n DO
IF abs(yk1[i]) > (1.0/meps) THEN StopCod:=2;
end { rk3h };
Procedure RK4h (n:integer;
h,t:real;
yk:vect;
Var yk1:vect;
Var stopCod:integer);
{ НАЗНАЧЕНИЕ
Одношаговый интегратор для системы ОДУ
по методу Рунге-Кутты 4-го порядка }
{ ВХОДНЫЕ ПАРАМЕТРЫ
n - порядок системы;
h - шаг интегрирования;
t - текущее значение аргумента;
yk - решение в точке t-h;
{ ВЫХОДНЫЕ ПАРАМЕТРЫ
yk1 - решение в точке t;
StopCod - код выхода из процедуры;
StopCod=1 - нормальное завершение
StopCod=2 - выявлена угроза неустойчивости; }
Var
k1,k2,k3,k4,kv:vect;
i:integer;
begin
stopCod:=1;
VectFun (n,t-h,yk,k1);
FOR i:=1 TO n DO kv[i]:=yk[i]+0.5*h*k1[i];
VectFun (n,t-0.5*h,kv,k2);
FOR i:=1 TO n DO kv[i]:=yk[i]+0.5*h*k2[i];
VectFun (n,t-0.5*h,kv,k3);
FOR i:=1 TO n DO kv[i]:=yk[i]+h*k3[i];
VectFun (n,t,kv,k4);
FOR i:=1 TO N DO
yk1[i]:=yk[i]+h*(k1[i]+2.0*k2[i]+2.0*k3[i]+k4[i])/6.0;
{ проверка на потерю устойчивости }
FOR i:=1 TO n DO
IF abs(yk1[i]) > (1.0/meps) THEN stopCod:=2;
End { rk4h };
Procedure IntegDriv (n,codMet:integer;
codx:invect;
t0,hOut,hMax,delt:real;
Var tm,h:real;
Var x:vect;
Var outT,fInp,out1,out2,out3:vectLong;
Var nout:integer);
{ НАЗНАЧЕНИЕ
Интегрирование системы обыкновенных дифференциальных уравнений
в форме Коши методом,определяемым параметром codMet, на
интервале [t0,tm].
{ ВХОДНЫЕ ПАРАМЕТРЫ
n - порядок системы;
CodMet = 1 - явный метод Эйлера;
CodMet = 2 - нeявный Эйлера по схеме П(ВК);
CodMet = 4 - трапеции по схеме П(ВК);
CodMet = 7 - явный Рунге-Кутты 2-го порядка;
CodMet = 8 - явный Рунге-Кутты 3-го порядка;
CodMet = 9 - явный Рунге-Кутты 4-го порядка;
CodMet = 10 - явный Рунге-Кутты-Фельберга 4-го порядка;
t0 - начальное значения аргумента;
hMax - максимально допустимый шаг интегрирования;
hOut - шаг записи значений контролируемых компонент вектора
состояния в промежуточных точках интервала интегри-
рования в массивы вывода;
codx - вектор, значения компонент которого суть номера конт-
ролируемых компонент вектора состояния; }
{ ВХОДНО - ВЫХОДНЫЕ ПАРАМЕТРЫ
tm - на входе - конечное значение аргумента;
на выходе - значение аргумента,при котором завершено
интегрирование;
h - текущее значение шага;
x - на входе - вектор состояния при значении аргумента t0.
на выходе - вектор состояния при значении аргумента tm;
out1,out2,out3 - массивы,в которых записаны значения конт-
ролируемых компонент вектора состояния;
outT - массив ,в котором записаны значения аргумента соответст-
вующиe значениям вектора состояния в массивах out1..out3;
fInp - массив,в котором записаны значения входного воздействия;
nout - число информативных элементов выходных массивов. }
{ ГЛОБАЛЬНЫЕ ПЕРЕМЕННЫЕ
meps - машинный эпсилон }
Var
k,kmax,j,i,ix,iout,kout,stopcod:integer;
tt,eps1,hh:real;
bk,bk1:vect;
fla2:boolean;
begin
hh:=h;
eps1:=delt/(tm-t0);
iout:=nOut; StopCod:=1;
outT[iout]:=t0;
i:=1;
WHILE (codx[i]>0) DO
begin
ix:=codx[i];
CASE i OF
1: out1[iout]:=x[ix];
2: out2[iout]:=x[ix];
3: out3[iout]:=x[ix];
end;
i:=i+1;
end;
iout:=nOut + 1;
tt:=t0;
FOR i:=1 TO n DO bk[i]:=x[i];
fla2:=false;
WHILE tt <= tm DO
begin
tt:=tt + h;
CASE codMet OF
7: RK2h (n,h,tt,bk,x,stopCod);
8: RK3h (n,h,tt,bk,x,stopCod);
9: RK4h (n,h,tt,bk,x,stopCod);
{ 10: RKF4h (n,hMax,eps1,h,tt,x,fla2,stopCod); }
end;
FOR i:=1 TO n DO bk[i]:=x[i];
IF StopCod > 1 THEN
begin
WriteLn;
WriteLn (' ':21,'ОСТАНОВ в одношаговом интеграторе.');
IF stopCod = 2 THEN
WriteLn (' ':16,'Выявлена неустойчивость',
' вычислительной схемы');
IF stopCod = 3 THEN
WriteLn (' ':6,'Выявлена плохая сходимость',
' на этапе коррекции вычислительной схемы');
WriteLn;
WriteLn (' ':21,'Для завершения работы нажмите ENTER');
ReadLn;
HALT;
end;
IF ((iOut-1)*hOut <= tt) or (tt=tm) THEN
begin
outT[iout]:=tt;
j:=1;
WHILE (codx[j]>0) DO
begin
ix:=codx[j];
CASE j OF
1: out1[iout]:=x[ix];
2: out2[iout]:=x[ix];
3: out3[iout]:=x[ix];
end;
j:=j+1;
end { while };
iout:=iout+1;
end;
IF ((tt + h) > (tm+1.0e-2*h)) and (tt < tm) THEN
h:=tm-tt;
IF iOut >= nLong THEN
begin
tMax:=tt;
nOut:=nLong;
WriteLn ('Интегрирование завершено по причине',
' заполнения массивов вывода информации');
WriteLn ('Для завершения работы нажмите ENTER');
ReadLn;
EXIT;
end;
IF tt=tm THEN tt:=tt+h;
end { { While tt <= tm };
nout:=iout-1;
h:=hh;
end { IntegDriv };
Begin
MashEps (meps);
ClrScr;
Frame (8,3,72,22);
GOTOxy (31,10);
Write ('п р о г р а м м а');
GOTOxy (33,11);
HighVideo;
Write (' " К О Ш И "');
LowVideo;
GOTOxy (30,14);
Write ('Н а з н а ч е н и е');
GOTOxy (19,16);
Write (' Изучение методов численного интегрирования');
GOTOxy (29,17);
Write ('задачи Коши для ОДУ');
GOTOxy (27,20);
Delay (60000);
1: ClrScr;
GOTOxy (30,10);
WriteLn ('УКАЖИТЕ НОМЕР ЗАДАЧИ');
WriteLn;
WriteLn (' ':25,'1 : тестовые линейные задачи');
WriteLn (' ':25,'16: тестовые нелинейные задачи');
WriteLn (' ':25,'31,32: рабочие нелинейные задачи');
ReadLn (numText);
IF (numText >=1) and (numText <=20) THEN tex:=true;
IF (numText >=21) and (numText <=40) THEN tex:=false;
ClrScr;
GOTOxy (22,10);
CASE numText OF
1: n:=2;
16: begin
n:=2;
WriteLn ('Введите значение параметра d (d > 0.1)');
ReadLn (dz);
WriteLn (' ':15,'Введите значение параметра ePs',
' (ePs > 0.0 и |ePs| < 0.15)');
ReadLn (ePp);
end;
end { case };
IF tex THEN
begin
GOTOxy (20,20);
Case numText OF
1: WriteLn ('Вы выбрали линейную задачу 2-го порядка');
16,31,32: WriteLn ('Вы выбрали нелинейную задачу',
n:2,'-го порядка');
end;
WriteLn;
WriteLn (' ':25,'Для продолжения нажмите "ENTER"');
ReadLn;
end;
ClrScr;
GOTOxy (1,10);
IF not tex THEN
begin
WriteLn (' ':24,'КАКОВ ПОРЯДОК СИСТЕМЫ УРАВНЕНИЙ - ?');
ReadLn (n);
end;
matrSys(n,numText,tex,dz,epp,ay);
IF (numText < 11) or ((not tex) and (numText < 31)) THEN
begin
MatVec (1,n,n,alon,ay);
PHsbg (n,n,alon);
AigVel (n,n,ian,rr,ri,alon);
ClrScr;
GOTOxy(1,5);
WriteLn (' ':13,'С О Б С Т В Е Н Н Ы Е Ч И С Л А З А Д А Ч И: ');
WriteLn (' ':29,'Real',' ':8,'Image');
FOR i:=1 TO n DO WriteLn (' ':25,rr[i]:12,' ',ri[i]:12);
WriteLn;
WriteLn (' ':22,'Для продолжения нажмите ENTER ');
ReadLn;
end;
ClrScr;
GOTOxy (1,5);
WriteLn (' М Е Т О Д Ы ':45);
WriteLn;
WriteLn (' ':22,'7 - явный метод Рунге-Кутты 2 порядка');
WriteLn (' ':22,'8 - явный метод Рунге-Кутты 3 порядка');
WriteLn (' ':22,'9 - явный метод Рунге-Кутты 4 порядка');
WriteLn;
WriteLn (' ':35,'Ваш выбор -?');
ReadLn (met);
ClrScr;
GOTOxy (1,5);
If tex Then
begin tmin:=0.0;
tmin:=0.0;
IF numText=14 THEN tmin:= 1.0;
IF (numText=16) or (numText=7) THEN tMin:=epp;
WriteLn (' ':20,'Левая граница интервала интегрирования=',tmin:12);
end
ELSE
begin
WriteLn (' ':20,'Укажите левую границу интервала интегрирования');
ReadLn (tmin);
end;
WriteLn;
WriteLn (' ':20,'Укажите правую границу интервала интегрирования');
ReadLn (tmax);
WriteLn;
hMax:=(tMax-tMin)/100.0;
hCons:=true; cc:='n';
IF (met=10) THEN cc:='y';
IF (cc='y') or (cc='Y') THEN hCons:=false ELSE hCons:=true;
IF hCons THEN
begin
WriteLn (' ':25,'Задайте шаг интегрирования');
ReadLn (ht);
delt:=1.0;
end
ELSE
ht:=0.1*hMax;
WriteLn;
IF not hCons THEN
begin
WriteLn (' ':23,'Задайте желаемую точность интегрирования');
ReadLn (delt);
end;
WriteLn;
FOR i:=1 TO n+2 DO codx[i]:=0;
WriteLn ('Определите количество контролируемых компонент',
' вектора состояния (не более 3-х)');
ReadLn (i);
WriteLn (' ':30,'Укажите их номера');
FOR j:=1 TO i DO
ReadLn (codx[j]);
ClrScr;
hot:=(tmax - tmin)/(nLong-5);
GOTOxy (1,5);
WriteLn (' ':4,'Шаг фиксации значений вектора состоянмя ?',
' ( не менее ',hot:12,' )');
ReadLn (hot);
IF (not Tex) THEN
begin
WriteLn (' ':25,'Начальное состояние - ?');
FOR i:=1 TO n DO ReadLn (x[i]);
FOR i:=1 TO n DO rr[i]:=x[i];
end
ELSE
CASE numText OF
1: begin
x[1]:=0.0; x[2]:=1.0;
end;
16:begin
x[1]:=epp*Ln(epp/(epp+0.1)) / dz;
x[2]:=Ln(epp/(epp+0.1)) / dz + 0.1/(dz*(epp+0.1));
end;
end { case };
FOR i:=1 TO nLong DO
begin
memT[i]:=0.0; mem1[i]:=0.0; mem2[i]:=0.0;
mem3[i]:=0.0; memIn[i]:=0.0; memOut[i]:=0.0;
end;
nk:=1; nk0:=1;
REPEAT
ClrScr;
GOTOxy (1,20);
WriteLn (' ':19,'И Д Ё Т И Н Т Е Г Р И Р О В А Н И Е');
CASE met OF
7,8,9: IntegDriv (n,met,codx,tMin,hOt,hMax,delt,tMax,
ht,x,memT,memIn,mem1,mem2,mem3,nk);
12: ;
end { case };
IF not tex THEN
begin
GOTOxy (20,7);
WriteLn ('Существует ЭТАЛОННОЕ решение ? (Y/N)');
ReadLn (cc);
IF (cc='y') or (cc='Y') THEN
begin
WriteLn (' ':17,'Укажите имя файла,в котором оно записано');
ReadLn (namfl);
ASSIGN (fl,namfl);
RESET (fl);
ReadLn (fl,typIn);
IF numText >= 21 THEN
WriteLn (' ':10,'(в качестве решения принята',
typIn:2,'-я наблюдаемая компонента)');
nkSt:=0;
WHILE not Eof(fl) DO
begin
nkSt:=nkSt+1;
ReadLn (fl,memIn[nkSt],memOut[nkSt]);
end;
CLOSE (fl);
CASE typIn OF
1:FOR i:=1 TO nk DO alon[i]:=mem1[i];
2:FOR i:=1 TO nk DO alon[i]:=mem2[i];
3:FOR i:=1 TO nk DO alon[i]:=mem3[i];
end;
{ вычисление ошибки функции выхода }
typY:=0.0;
FOR i:=1 TO nk DO typY:=typY + abs(alon[i]);
typY:=typY/nk;
IF typY < 1e-20 THEN typY:=1.0;
alon2[1]:=0.0;
FOR i:=2 TO nk-1 DO
begin
t:=memT[i];
j:=2;
WHILE (t > memIn[j]) and (j < nkSt) DO j:=j+1;
IF (j=2) or (j=nkSt) THEN
yt:=memOut[j] + (memOut[j-1]-memOut[j])*(t-memIn[j])/
(memIn[j-1]-memIn[j]);
IF (j > 2) and (j < nkSt) THEN
begin
FOR jj:=1 TO 4 DO fxi[jj]:=memOut[j-3+jj];
FOR jj:=1 TO 4 DO tNet[jj]:=memIn[j-3+jj];
CoefLag (3,tNet,fxi,fLag,stopCod);
IF stopCod=1 THEN PolLag (3,fLag,tNet,t,yt);
end;
GOTOxy(5,15);
IF (j > nkSt) THEN
begin
WriteLn ('Дальнейшее вычисление погрешности',
' не возможно, т.к. эталонное решение');
WriteLn (' ':5,' не определено при значениях',
' аргумента больших ',mem1[nkSt]:12 );
end;
alon2[i]:=abs(alon[i]-yt)/typY;
end;
FOR i:=1 TO nk DO memIn[i]:=alon2[i];
end
ELSE
begin
WriteLn (' ':13,'Полученное решение записать',
' в качестве эталонного ? (Y/N)');
ReadLn (cc);
IF (cc='y') or (cc='Y') THEN
begin
WriteLn (' ':13,'Укажите номер наблюдаемой компоненты',
',принимаемой за решение');
ReadLn (typIn);
WriteLn (' ':14,'Укажите имя файла,в котором оно',
' будет записано (***.txt)');
ReadLn (namfl);
ASSIGN (fl,namfl);
REWRITE (fl);
WriteLn (fl,typIn:2);
CASE typIn OF
1: FOR i:=1 TO nk DO
WriteLn (fl,memT[i],' ',mem1[i]);
2: FOR i:=1 TO nk DO
WriteLn (fl,memT[i],' ',mem2[i]);
3: FOR i:=1 TO nk DO
WriteLn (fl,memT[i],' ',mem3[i]);
end;
jj:=-1;
CLOSE (fl);
end
ELSE jj:=-1;
end;
end;
ClrScr;
GOTOxy (1,7);
WriteLn (' ':20,'Р И С У Е М К А Р Т И Н К У ?');
WriteLn (' ':30,'(Y/N)');
WriteLn;
Readln (c);
IF (c='Y') or (c='y') THEN
begin
REPEAT
nLef:=1; nRit:=nk;
ClrScr;
GOTOxy (32,7);
WriteLn ('Г Р А Ф И К');
Writeln;
num1:=0; num2:=0;
WriteLn (' ':18,'1 - первой наблюдаемой компоненты',
' вектора состояния');
IF codx[2] > 0 THEN
WriteLn (' ':18,'2 - второй наблюдаемой компоненты',
' вектора состояния ');
IF codx[3] > 0 THEN
WriteLn (' ':18,'3 - третьей наблюдаемой компоненты',
' вектора состояния ');
IF tex THEN begin
WriteLn (' ':18,'4 - погрешности вычисления выбранной',
' компоненты');
WriteLn (' ':24,'по отношению к точному решению ');
end;
IF not tex and (jj <> -1) THEN begin
WriteLn (' ':18,'4 - погрешности',typIn:2,
'-ой наблюдаемой компоненты');
WriteLn (' ':24,'по отношению к эталонному решению ');
end;
WriteLn (' ':18,'5 - фазовый портрет процесса ');
GOTOxy(18,17);
WriteLn('(не более двух рисунков; ecли один,то',
' второе число - 0)');
GOTOxy(31,19);
WriteLn ('В а ш в ы б о р ?');
ReadLn (num1,num2);
IF (num1=5) or (num2=5) THEN
begin
WriteLn;
WriteLn (' ':17,'Задайте номера наблюдаемых переменных',
' состояния,');
WriteLn (' ':22,'фазoвый портрет которых Вас интересует');
ReadLn (nf1,nf2);
CASE nf2 OF
1: FOR i:=1 TO nk DO memOut[i]:=mem1[i];
2: FOR i:=1 TO nk DO memOut[i]:=mem2[i];
3: FOR i:=1 TO nk DO memOut[i]:=mem3[i];
end;
end;
IF tex THEN
CASE num1 OF
1: begin
j:=codx[num1];
typY:=0.0;
FOR i:=1 TO nk DO typY:=typY + abs(mem1[i]);
typY:=typY/nk;
IF typY < 1e-20 THEN typY:=1.0;
FOR i:=1 TO nk DO
begin
TextFun (n,memT[i],x0);
memIn[i]:=(abs(x0[j]-mem1[i]));
{ IF abs(x0[j]) < typY THEN }
memIn[i]:=memIn[i] / typY
{ ELSE memIn[i]:=memIn[i] / abs(x0[j])};
end;
end;
2: begin
j:=codx[num1];
typY:=0.0;
FOR i:=1 TO nk DO typY:=typY + abs(mem2[i]);
typY:=typY/nk;
IF typY < 1e-20 THEN typY:=1.0;
FOR i:=1 TO nk DO
begin
TextFun (n,memT[i],x0);
memIn[i]:=(abs(x0[j]-mem2[i]));
{ IF abs(x0[j]) < typY THEN }
memIn[i]:=memIn[i] / typY
{ ELSE memIn[i]:=memIn[i] / abs(x0[j])};
end;
end;
3: begin
j:=codx[num1];
typY:=0.0;
FOR i:=1 TO nk DO typY:=typY + abs(mem3[i]);
typY:=typY/nk;
IF typY < 1e-20 THEN typY:=1.0;
FOR i:=1 TO nk DO
begin
TextFun (n,memT[i],x0);
memIn[i]:=(abs(x0[j]-mem3[i]));
{ IF abs(x0[j]) < typY THEN }
memIn[i]:=memIn[i] / typY
{ ELSE memIn[i]:=memIn[i] / abs(x0[j])};
end;
end;
end { case };
11: IF num2 > 0 THEN
begin
xl1:=0.01; yl1:=0.01;
xr1:=0.99; yr1:=0.49;
xl2:=0.01; yl2:=0.51;
xr2:=0.99; yr2:=0.99;
end
ELSE
begin
xl1:=0.01; yl1:=0.01;
xr1:= 0.99; yr1:=0.99;
end;
FOR i:=1 TO nk+5 DO alon[i]:=0.0;
FOR i:=1 TO nk+5 DO alon2[i]:=0.0;
CASE num1 OF
1: FOR i:=1 TO nRit-nLef DO alon[i]:=mem1[i+nLef-1];
2: FOR i:=1 TO nRit-nLef DO alon[i]:=mem2[i+nLef-1];
3: FOR i:=1 TO nRit-nLef DO alon[i]:=mem3[i+nLef-1];
4: FOR i:=1 TO nRit-nLef DO alon[i]:=memIn[i+nLef-1];
5: FOR i:=1 TO nRit-nLef DO alon[i]:=memOut[i+nLef-1];
end;
CASE num2 OF
1: FOR i:=1 TO nRit-nLef DO alon2[i]:=mem1[i+nLef-1];
2: FOR i:=1 TO nRit-nLef DO alon2[i]:=mem2[i+nLef-1];
3: FOR i:=1 TO nRit-nLef DO alon2[i]:=mem3[i+nLef-1];
4: FOR i:=1 TO nRit-nLef DO alon2[i]:=memIn[i+nLef-1];
5: FOR i:=1 TO nRit-nLef DO alon2[i]:=memOut[i+nLef-1];
end;
IF ((num1=5) or (num2=5)) THEN
CASE nf1 OF
1: FOR i:=1 TO nRit-nlef DO memArg[i]:=mem1[i+nLef-1];
2: FOR i:=1 TO nRit-nlef DO memArg[i]:=mem2[i+nLef-1];
3: FOR i:=1 TO nRit-nlef DO memArg[i]:=mem3[i+nLef-1];
end
ELSE FOR i:=1 TO nRit-nlef DO memArg[i]:=memT[i+nLef-1];
grdr:=detect;
INITGRAPH (grdr,grmd,'');
ercd:=GRAPHRESULT;
IF (ercd <> 0) THEN
begin
WriteLn ('Oшибка графики :',GRAPHERRORMSG(ercd));
WriteLn ('Программа аварийно завершила работу');
HALT (1);
end;
IF (num2 > 0) THEN
begin
Grafic (7,1,4,nRit-nLef,xl1,yl1,xr1,yr1,memArg,alon);
{ ReadLn; }
Grafic (7,1,4,nRit-nLef,xl2,yl2,xr2,yr2,memArg,alon2);
end;
IF (num1>0) and (num2=0) THEN
Grafic (7,1,5,nRit-nLef,xl1,yl1,xr1,yr1,memArg,alon);
ReadLn;
CloseGraph;
ClrScr;
GoToXY (1,7);
Writeln (' ':15,'Вы имеете возможность просмотреть',
' интересные участки');
Writeln (' ':15,'полученных зависимостей указав',
' соответствующие границы');
WriteLn (' ':25,'интервала изменения аргумента');
GoToXY (1,17);
WriteLn (' ':20,'Есть ли у Вас такая необходимость ? (Y/N)');
ReadLn (c);
IF (c='y') or (c='Y') THEN
begin
WHILE (c='Y') or (c='y') DO
begin
ClrScr;
GoToXY (1,7);
WriteLn (' ':30,'Определите левую границу');
ReadLn (xLef);
IF xLef=tMin THEN xLef:=xlef+hot;
WriteLn (' ':30,'Определите правую границу');
ReadLn (xRit);
IF xRit=tMax THEN xRit:=xRit - hot;
IF (xRit > tMax-hot) or (xLef >= tMax) THEN
begin
WriteLn (' ':15,'Границы не могут превосходить ',
tMax:12);
WriteLn (' ':30,'Переопределите их ');
GoTOXY (25,20);
WriteLn ('Для продолжения нажмите ENTER');
ReadLn;
end
ELSE c:='n';
end;
i:=1;
IF xLef < tMax - hot THEN
WHILE (xLef > memT[i]) and (memT[i] < tMax) DO
i:=i+1;
nLef:= i-1;
IF xRit < tMax - hot THEN
While (xRit > memT[i]) and (memT[i] < tMax) DO
i:=i+1;
nRit:=i;
goto 11;
end
ELSE
begin
WriteLn (' ':9,'Есть ли у Вас необходимость просмотра',
' других зависимостей ? (Y/N)');
ReadLn (c);
end;
UNTIL (c='n') or (c='N')
end; { if c='Y' }
ClrScr;
GOTOxy (1,7);
cc:='n';
IF (cc='y') or (cc='Y') THEN
begin
nk0:=nk;
tmin:=tmax;
WriteLn (' ':10,'Задайте новое значение верхней границы',
' интервала интегрирования');
tMax:=tMax + (nLong-nk)*hOt;
WriteLn (' ':25,'(не более ',tMax:12,' )');
ReadLn (tmax);
end;
UNTIL (cc='n') or (cc='N') ;
WriteLn;
WriteLn (' ':20,'ПЕРЕХОДИМ К СЛЕДУЮЩЕЙ ЗАДАЧЕ - ? (Y/N)');
ReadLn (cc);
IF (cc='y') or (cc='Y') THEN GoTo 1;
end.
Документ
Категория
Рефераты
Просмотров
8
Размер файла
121 Кб
Теги
приложение
1/--страниц
Пожаловаться на содержимое документа