Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
SOME / 2 / PROGRAM.DOC
Скачиваний:
2
Добавлен:
16.04.2013
Размер:
27.14 Кб
Скачать

I:integer;

Fi:real;

begin

can.rl:=0;

can.im:=0;

For i:=-n to n do

Begin

Fi:=phr[i]+spd[i,1];

can.rl:=can.rl+cos(Fi)*ErrArray[i,cnl];

can.im:=can.im+sin(Fi)*ErrArray[i,cnl]

end;

end;

Procedure DiscDiagr(t1:real;tp:integer);

var j:integer;

t,l:real;

can:comp;

begin

t:=-range/2;

PhaseRasp(t1);

For j:=0 to Xmax do

begin

SpaceDist(t,r);

Discrt(tp); {¤ЁбЄаҐвЁ§ жЁп а бЇаҐ¤Ґ«Ґ­Ёп}

Chanel(1,can);

rez[j]:=sqr(can.rl)+sqr(can.im);

t:=t+step

end

end;

Procedure Diagr(t1:real);

var i,j:integer;

t,err,k,rl,im,Fi,sint,l:real;

begin

t:=-range/2;

for j:=0 to Xmax do

Begin

l:=d*cos(t);

rl:=0;

im:=0;

sint:=sin(t);

PhaseRasp(t1);

For i:=-n to n do

Begin

err:=ErrArray[i,1];

k:=kl*i*l*sint;

Fi:=phr[i]+k;

rl:=rl+cos(Fi)*err;

im:=im+sin(Fi)*err

end;

t:=t+step;

rez[j]:=sqr(rl)+sqr(im)

end

end;

Procedure Discrim(tt:real;tp:integer);

var

lt,rt,can:comp;

I:integer;

ph,ft,ri,fi,t:real;

Begin

PhaseRasp(tt);

Discrt(tp);

t:=-range/2;

For i:=0 to Xmax do

Begin

ri:=sqrt(sqr(r*sin(t)+n*d)+sqr(r*cos(t)));

fi:=arctan((r*sin(t)+n*d)/r/cos(t));

SpaceDist(fi,ri);

Chanel(1,lt);

ri:=sqrt(sqr(r*sin(t)-n*d)+sqr(r*cos(t)));

fi:=arctan((r*sin(t)+n*d)/r/cos(t));

SpaceDist(fi,ri);

Chanel(2,rt);

ft:=arctan(-lt.im/lt.rl);

ph:=arctan(-rt.im/rt.rl);

rez[i]:=ft-ph;

t:=t+step

end

End;

Procedure Summary(tt:real;tp:integer);

var

lt,rt,can:comp;

I:integer;

ph,ft,ri,fi,t:real;

Begin

PhaseRasp(tt);

Discrt(tp);

t:=-range/2;

For i:=0 to Xmax do

Begin

ri:=sqrt(sqr(r*sin(t)+n*d)+sqr(r*cos(t)));

fi:=arctan((r*sin(t)+n*d)/r/cos(t));

SpaceDist(fi,ri);

Chanel(1,lt);

ri:=sqrt(sqr(r*sin(t)-n*d)+sqr(r*cos(t)));

fi:=arctan((r*sin(t)+n*d)/r/cos(t));

SpaceDist(fi,ri);

Chanel(2,rt);

ft:=arctan(-lt.im/lt.rl);

ph:=arctan(-rt.im/rt.rl);

rez[i]:=ft-ph;

t:=t+step

end

End;

Procedure PhaseDet(t:real;var phsdet:real);

var

lt,rt,sm,dm:comp;

ri,Fi:real;

Begin

ri:=sqrt(sqr(r*sin(t)+n*d)+sqr(r*cos(t)));

fi:=arctan((r*sin(t)+n*d)/r/cos(t));

SpaceDist(fi,ri);

Chanel(1,lt);

ri:=sqrt(sqr(r*sin(t)-n*d)+sqr(r*cos(t)));

fi:=arctan((r*sin(t)+n*d)/r/cos(t));

SpaceDist(fi,ri);

Chanel(2,rt);

sm.rl:=lt.rl+rt.rl;

sm.im:=lt.im+rt.Im;

dm.rl:=rt.rl-lt.rl;

dm.im:=rt.im-lt.im;

PDet:=(sm.rl*dm.rl+sm.im*dm.im);

PhsDet:=Pdet/(sqr(sm.rl)+sqr(dm.im))

End;

Procedure Scan(tp:integer);

var

l,Ft,Ft1,dF,pdet,phdet,pdet1:real;

i,j:integer;

Begin

for i:=0 to 50 do

begin

Ft:=i*(OneGrd);

dF:=0.5*OneGrd;

Ft1:=Ft;

pdet1:=0;

CurVal:=0;

Repeat

PhaseRasp(Ft1);

Discrt(tp);

PhaseDet(Ft1,phdet);

if sign(phdet)<>sign(pdet1) then df:=-df*0.5*sign(phdet);

pdet1:=phdet;

Ft1:=Ft1+dF;

Until abs(df)<OneGrd*0.06;

rez[i]:=(Ft1-ft)/onegrd;

CurVal:=sqr(rez[i]/8)+curval

end;

CurVal:=sqrt(curval)

end;

BEGIN

tt:=0;

kl:=2*Pi/lambda;

n:=2;

d:=5;

r1:=10000;

r:=r1*100;

tp:=0;

For i:=-n to n do

Begin

ErrArray[i,1]:=1;

ErrArray[i,2]:=1

End;

range:=Pi/1.8;

driver:=VGA;

regim:=VGAHi;

InitGraph(driver,regim,'e:\_arhiv_\tp70\bgi');

Xmax:=Getmaxx;

xc:=(Xmax+1)div 2;

Ymax:=Getmaxy;

yc:=(Ymax+1)div 2;

SetTextStyle(7,0,1);

Outtext('Choose Function { d-Discrim, s-Summary,p-PhaseDet}:');

SetTextStyle(0,0,1);

InSwitch(ch);

SetWriteMode(CopyPut);

GetViewSettings(Window);

While ch<>chr(27) Do

Begin

Step:=range/(Xmax+1);

SetColor(LightRed);

SetTextStyle(7,0,3);

OutTextXY(250,220,'Please WAIT');

SetTextStyle(0,0,1);

If not ExitCode Then

Case ch of

's':scan(tp);

'd':Discrim(tt*OneGrd,tp);

'p':PhaseDet(tt,tp);

'+':Summary(tt,tp);

'-':Discrim(tt,tp);

end;

With Window do SetViewPort(x1,y1,x2,y2,clip);

ClearViewPort;

Draw50(rez);

Screen;

ch1:=ch;

InSwitch(ch);

ExitCode:=false;

Case ch of

'*':InpRange;

'/':range:=PI;

'l':Input('i',120,50,tp,WkR);

'r':Input('r',120,40,WkI,tt);

'n':

Begin

Input('i',50,30,n,WkR);

For i:=-n to n do

begin

ErrArray[i,1]:=1;

ErrArray[i,2]:=1

End

End;

'q':

begin

cnl:=1;

ErrInput

end;

'w':

begin

cnl:=2;

ErrInput

End

End;

r:=r1*100;

If not(ch in ['s','d','p','+','-',chr(27)]) Then ch:=ch1;

End

END.

Тут вы можете оставить комментарий к выбранному абзацу или сообщить об ошибке.

Оставленные комментарии видны всем.

Соседние файлы в папке 2