summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ROM.lpi2
-rw-r--r--ROM.lpr47
-rw-r--r--ROM.lps113
-rw-r--r--romunit.pas68
4 files changed, 120 insertions, 110 deletions
diff --git a/ROM.lpi b/ROM.lpi
index 038838a..07e671c 100644
--- a/ROM.lpi
+++ b/ROM.lpi
@@ -38,12 +38,10 @@
<Unit1>
<Filename Value="romunit.pas"/>
<IsPartOfProject Value="True"/>
- <UnitName Value="romunit"/>
</Unit1>
<Unit2>
<Filename Value="mathunit.pas"/>
<IsPartOfProject Value="True"/>
- <UnitName Value="mathunit"/>
</Unit2>
</Units>
</ProjectOptions>
diff --git a/ROM.lpr b/ROM.lpr
index ae493b2..898a35b 100644
--- a/ROM.lpr
+++ b/ROM.lpr
@@ -10,14 +10,17 @@ uses
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this },
- SysUtils,ROMunit, matheunit, Math;
+ SysUtils,ROMunit, matheunit, Math, systemunit;
-var inPulsO,inPuls,refPulsO,refPuls,surTraj,cRefPuls: tExtPointArray;
- smooth,betaSmooth: longint;
- tmax,wmax,absShift,betaBound: extended;
- force,fourier,mitAmplMod: boolean;
- f: textfile;
- s,t,u,lpicIn,rohIn,rohRef,outIn,outRef,outRefC,outSur: string;
+var
+ inPulsO,inPuls,refPulsO,refPuls,
+ surTraj,cRefPuls,surVel: tExtPointArray;
+ smooth,betaSmooth,veloSmooth: longint;
+ tmax,wmax,absShift,betaBound,veloBound: extended;
+ force,fourier,mitAmplMod: boolean;
+ f: textfile;
+ s,t,u,lpicIn,rohIn,rohRef,outIn,
+ outRef,outRefC,outSur,outVel: string;
//const Verwendung='Verwendung: ROM ($Einfallspuls_Datei $Ausfallspuls_Datei)/(- $trace-Datei-Prefix) $output_inPuls $output_refPuls $output_Trajektorie $output_cRefPuls '+
// '[-s/--smooth $n] [-f/--force] [-t/--tmax $t] [-w/--wmax $w] [-F/--FFT] [-d/--dt $dt]';
@@ -35,6 +38,8 @@ begin
betaBound:=0.95;
fourier:=false;
mitAmplMod:=true;
+ veloSmooth:=1;
+ veloBound:=1;
lpicIn:='';
rohIn:='';
@@ -43,6 +48,7 @@ begin
outRef:='';
outRefC:='';
outSur:='';
+ outVel:='';
assignfile(f,paramstr(1));
reset(f);
@@ -87,13 +93,25 @@ begin
smooth:=strtoint(s);
continue;
end;
+ if pos('Trajektoriengeschwindigkeitsglätte:',s)=1 then begin
+ delete(s,1,pos(':',s));
+ s:=trim(s);
+ veloSmooth:=strtoint(s);
+ continue;
+ end;
+ if pos('Trajektorien-Maximalgeschwindigkeit:',s)=1 then begin
+ delete(s,1,pos(':',s));
+ s:=trim(s);
+ veloBound:=strtofloat(s);
+ continue;
+ end;
if pos('Betaglätte:',s)=1 then begin
delete(s,1,pos(':',s));
s:=trim(s);
betaSmooth:=strtoint(s);
continue;
end;
- if pos('Maximalgeschwindigkeit:',s)=1 then begin
+ if pos('AM-Maximalgeschwindigkeit:',s)=1 then begin
delete(s,1,pos(':',s));
s:=trim(s);
betaBound:=strtofloat(s);
@@ -168,6 +186,11 @@ begin
outSur:=trim(s);
continue;
end;
+ if pos('geschwindigkeit-Ziel:',s)=1 then begin
+ delete(s,1,pos(':',s));
+ outVel:=trim(s);
+ continue;
+ end;
Fehler('Unbekannter Parameter '''+s+''' in Inputdatei '''+paramstr(1)+'''!');
end;
closefile(f);
@@ -238,16 +261,22 @@ begin
sort(surTraj);
writeln(stderr,' fertig');
uniq(surTraj,false);
+ write(stderr,'Geschwindigkeit berechnen ...');
+ ableiten(surTraj,surVel,veloSmooth,veloBound);
+ writeln(stderr,' fertig');
write(stderr,'Reflektierten Puls berechnen ...');
berechneRefPuls(inPulsO,surTraj,betaSmooth,betaBound,cRefPuls);
writeln(stderr,' fertig');
if fourier then begin
write(stderr,'Ergebnis interpolieren ...');
interpoliere(surTraj);
+ if outVel<>'' then
+ interpoliere(surVel);
writeln(stderr,' fertig');
fft(inPuls);
fft(refPuls);
fft(surTraj);
+ fft(surVel);
inPuls[0].y:=0;
refPuls[0].y:=0;
surTraj[0].y:=0;
@@ -255,6 +284,7 @@ begin
cut(surTraj,min(refPuls[length(refPuls)-1].x,inPuls[length(inPuls)-1].x)/2);
cut(inPuls,surTraj[length(surTraj)-1].x);
cut(refPuls,surTraj[length(surTraj)-1].x);
+ cut(surVel,surTraj[length(surTraj)-1].x);
end
else begin
cut(surTraj,wmax);
@@ -276,6 +306,7 @@ begin
writeOutput(outRef,refPuls);
end;
if outSur<>'' then writeOutput(outSur,surTraj);
+ if outVel<>'' then writeOutput(outVel,surVel);
if outRefC<>'' then writeOutput(outRefC,cRefPuls);
end.
diff --git a/ROM.lps b/ROM.lps
index f33f690..77633ee 100644
--- a/ROM.lps
+++ b/ROM.lps
@@ -3,24 +3,22 @@
<ProjectSession>
<Version Value="9"/>
<BuildModes Active="Default"/>
- <Units Count="5">
+ <Units Count="6">
<Unit0>
<Filename Value="ROM.lpr"/>
<IsPartOfProject Value="True"/>
- <TopLine Value="221"/>
- <CursorPos X="11" Y="242"/>
- <UsageCount Value="96"/>
+ <IsVisibleTab Value="True"/>
+ <TopLine Value="19"/>
+ <CursorPos X="16" Y="42"/>
+ <UsageCount Value="97"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="romunit.pas"/>
<IsPartOfProject Value="True"/>
- <IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
- <TopLine Value="541"/>
- <CursorPos Y="579"/>
- <FoldState Value=" T3iD041 pkRkZ0Y113 piYnW08112]Bbm1054 pj3jI0S1]9Ck10P7]Rejg]wz"/>
- <UsageCount Value="96"/>
+ <FoldState Value=" T3iD041 pkRkZ0Y2 pjOkL093 piXj70G[I4AjW0M6]94je0S1]9Ck10P7[a5Z0xV"/>
+ <UsageCount Value="97"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
@@ -28,14 +26,14 @@
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos Y="10"/>
- <UsageCount Value="95"/>
+ <UsageCount Value="96"/>
</Unit2>
<Unit3>
<Filename Value="../units/matheunit.pas"/>
<EditorIndex Value="2"/>
<TopLine Value="26"/>
<CursorPos X="10" Y="22"/>
- <UsageCount Value="10"/>
+ <UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@@ -43,127 +41,132 @@
<EditorIndex Value="-1"/>
<UsageCount Value="10"/>
</Unit4>
+ <Unit5>
+ <Filename Value="../units/systemunit.pas"/>
+ <EditorIndex Value="3"/>
+ <CursorPos Y="16"/>
+ <FoldState Value=" T3K0U5:"/>
+ <UsageCount Value="10"/>
+ <Loaded Value="True"/>
+ </Unit5>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="ROM.lpr"/>
- <Caret Line="196" Column="45" TopLine="175"/>
+ <Caret Line="35" Column="12" TopLine="4"/>
</Position1>
<Position2>
<Filename Value="ROM.lpr"/>
- <Caret Line="199" Column="15" TopLine="178"/>
+ <Caret Line="99" Column="16" TopLine="87"/>
</Position2>
<Position3>
- <Filename Value="ROM.lpr"/>
- <Caret Line="201" Column="15" TopLine="180"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="8" Column="33"/>
</Position3>
<Position4>
- <Filename Value="ROM.lpr"/>
- <Caret Line="203" Column="34" TopLine="182"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="32" Column="26"/>
</Position4>
<Position5>
- <Filename Value="ROM.lpr"/>
- <Caret Line="208" Column="18" TopLine="187"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="563" Column="17" TopLine="521"/>
</Position5>
<Position6>
<Filename Value="ROM.lpr"/>
- <Caret Line="157" Column="45" TopLine="127"/>
+ <Caret Line="278" Column="30" TopLine="241"/>
</Position6>
<Position7>
- <Filename Value="romunit.pas"/>
- <Caret Line="1005" Column="6" TopLine="816"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="271" Column="16" TopLine="241"/>
</Position7>
<Position8>
- <Filename Value="romunit.pas"/>
- <Caret Line="990" TopLine="974"/>
+ <Filename Value="ROM.lpr"/>
</Position8>
<Position9>
<Filename Value="romunit.pas"/>
- <Caret Line="994" Column="45" TopLine="973"/>
+ <Caret Line="287" TopLine="43"/>
</Position9>
<Position10>
<Filename Value="romunit.pas"/>
- <Caret Line="1003" Column="86" TopLine="974"/>
</Position10>
<Position11>
- <Filename Value="ROM.lpr"/>
- <Caret Line="208" TopLine="204"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="13" Column="22"/>
</Position11>
<Position12>
<Filename Value="ROM.lpr"/>
- <Caret Line="207" Column="47" TopLine="186"/>
+ <Caret Line="293" Column="47" TopLine="255"/>
</Position12>
<Position13>
- <Filename Value="ROM.lpr"/>
- <Caret Line="70" Column="7" TopLine="28"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="33" Column="20" TopLine="9"/>
</Position13>
<Position14>
- <Filename Value="romunit.pas"/>
- <Caret Line="987" Column="101" TopLine="520"/>
+ <Filename Value="../units/systemunit.pas"/>
</Position14>
<Position15>
- <Filename Value="romunit.pas"/>
- <Caret Line="1028" Column="50" TopLine="521"/>
+ <Filename Value="../units/systemunit.pas"/>
+ <Caret Line="130" TopLine="70"/>
</Position15>
<Position16>
- <Filename Value="romunit.pas"/>
- <Caret Line="1024" Column="23" TopLine="759"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="249" Column="3" TopLine="229"/>
</Position16>
<Position17>
<Filename Value="ROM.lpr"/>
- <Caret Line="63" Column="18" TopLine="25"/>
+ <Caret Line="53" Column="8" TopLine="33"/>
</Position17>
<Position18>
- <Filename Value="romunit.pas"/>
- <Caret Line="202" Column="50" TopLine="183"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="13" Column="48"/>
</Position18>
<Position19>
<Filename Value="romunit.pas"/>
- <Caret Line="48" Column="32" TopLine="37"/>
+ <Caret Line="24" Column="12" TopLine="5"/>
</Position19>
<Position20>
- <Filename Value="ROM.lpr"/>
- <Caret Line="204" Column="10" TopLine="174"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="23" Column="20" TopLine="5"/>
</Position20>
<Position21>
- <Filename Value="ROM.lpr"/>
- <Caret Line="225" TopLine="201"/>
+ <Filename Value="romunit.pas"/>
+ <Caret Line="24" Column="20" TopLine="5"/>
</Position21>
<Position22>
<Filename Value="ROM.lpr"/>
- <Caret Line="220" Column="5" TopLine="200"/>
+ <Caret Line="249" Column="15" TopLine="209"/>
</Position22>
<Position23>
<Filename Value="ROM.lpr"/>
- <Caret Line="13" Column="24"/>
+ <Caret Line="17" Column="58" TopLine="10"/>
</Position23>
<Position24>
- <Filename Value="../units/matheunit.pas"/>
- <Caret Line="34"/>
+ <Filename Value="ROM.lpr"/>
+ <Caret Line="97" Column="17" TopLine="79"/>
</Position24>
<Position25>
<Filename Value="ROM.lpr"/>
- <Caret Line="17" Column="33" TopLine="4"/>
+ <Caret Line="263" Column="37"/>
</Position25>
<Position26>
<Filename Value="ROM.lpr"/>
- <Caret Line="35" Column="12" TopLine="4"/>
+ <Caret Line="18" Column="58"/>
</Position26>
<Position27>
<Filename Value="ROM.lpr"/>
- <Caret Line="99" Column="16" TopLine="87"/>
+ <Caret Line="19" Column="32"/>
</Position27>
<Position28>
<Filename Value="romunit.pas"/>
- <Caret Line="8" Column="33"/>
+ <Caret Line="642" Column="98" TopLine="388"/>
</Position28>
<Position29>
<Filename Value="romunit.pas"/>
- <Caret Line="32" Column="26"/>
+ <Caret Line="638" Column="22" TopLine="387"/>
</Position29>
<Position30>
<Filename Value="romunit.pas"/>
- <Caret Line="563" Column="17" TopLine="521"/>
+ <Caret Line="626" TopLine="40"/>
</Position30>
</JumpHistory>
</ProjectSession>
diff --git a/romunit.pas b/romunit.pas
index a796540..9cf905e 100644
--- a/romunit.pas
+++ b/romunit.pas
@@ -22,6 +22,7 @@ procedure monotonieHerstellen(const dat: tExtPointArray; var minima,maxima: tLon
procedure gesamtverschiebung(var inPuls,outPuls: tExtPointArray; var absShift: extended);
procedure integrate(var dat: tExtPointArray); overload;
procedure integrate(indat: tExtPointArray; out outdat: tExtPointArray); overload;
+procedure ableiten(indat: tExtPointArray; out outdat: tExtPointArray; dist: longint; bound: extended);
procedure removeLinearOffset(var dat: tExtPointArray);
procedure flip(var dat: tExtPointArray);
procedure vereineExtrema(const dat1,dat2: tExtPointArray; var el1,el2: tLongintArray; toleranz: extended);
@@ -30,7 +31,6 @@ procedure fft(var dat: tExtPointArray);
procedure interpoliere(var dat: tExtPointArray);
procedure normiere(var dat: tExtPointArray);
procedure berechneRefPuls(inPuls,surTraj: tExtPointArray; betaGlaette: longint; betaBound: extended; out cRefPuls: tExtPointArray);
-function shellSubst(s: string): string;
type
tSortThread = class(tThread)
@@ -317,15 +317,8 @@ begin
vereineExtrema(inPuls,outPuls,exList[0],exList[2],0.5);
vereineExtrema(inPuls,outPuls,exList[1],exList[3],0.5);
- writeln;
- for i:=0 to 3 do begin
- for j:=0 to length(exList[i])-1 do
- write(exList[i,j],'(',j,') ');
- writeln;
- end;
-
setlength(stuecke,length(exList[0])+length(exList[1])-1);
- writeln(length(stuecke),' ',length(exList[0]),' ',length(exList[1]),' ',length(exList[2]),' ',length(exList[3]));
+
for i:=0 to length(stuecke)-1 do
for b1:=false to true do // Anfang / Ende
for b2:=false to true do // input / output
@@ -583,7 +576,7 @@ begin
end;
inc(i);
end;
- setlength(minima,j); writeln(length(maxima),' ',length(minima));
+ setlength(minima,j);
end;
procedure gesamtverschiebung(var inPuls,outPuls: tExtPointArray; var absShift: extended);
@@ -611,14 +604,16 @@ begin
end;
procedure integrate(var dat: tExtPointArray);
-var i: longint;
+var
+ i: longint;
begin
for i:=1 to length(dat)-1 do
dat[i].y:=dat[i].y * (dat[i].x-dat[i-1].x)+dat[i-1].y;
end;
procedure integrate(indat: tExtPointArray; out outdat: tExtPointArray);
-var i: longint;
+var
+ i: longint;
begin
setlength(outdat,length(indat));
outdat[0]:=indat[0];
@@ -628,6 +623,22 @@ begin
end;
end;
+procedure ableiten(indat: tExtPointArray; out outdat: tExtPointArray; dist: longint; bound: extended);
+var
+ i: longint;
+begin
+ bound:=abs(bound);
+ if dist<1 then dist:=1;
+ setlength(outdat,length(indat)-dist);
+ for i:=0 to length(outdat)-1 do begin
+ outdat[i].x:=(indat[i+dist].x+indat[i].x)/2;
+// outdat[i].y:=min(max((indat[i+dist].y-indat[i].y)/(indat[i+dist].x-indat[i].x),-bound),bound);
+ outdat[i].y:=(indat[i+dist].y-indat[i].y)/(indat[i+dist].x-indat[i].x);
+ if abs(outdat[i].y)>bound then
+ outdat[i].y:=nan;
+ end;
+end;
+
procedure removeLinearOffset(var dat: tExtPointArray);
var i: longint;
dx,dy: extended;
@@ -666,26 +677,6 @@ begin
for i:=0 to length(behalten[b])-1 do
behalten[b,i]:=false;
-(* i:=0;
- j:=0;
- b:=dat1[el1[0]].x > dat2[el2[0]].x;
- repeat
- if b then begin
- behalten[true,i]:=true;
- while (i+1<length(el1)) and ((j>=length(el2)) or (dat1[el1[i+1]].x <= dat2[el2[j]].x)) do
- inc(i);
- inc(i);
- b:=false;
- end
- else begin
- behalten[false,j]:=true;
- while (j+1<length(el2)) and ((i>=length(el1)) or (dat1[el1[i]].x > dat2[el2[j+1]].x)) do
- inc(j);
- inc(j);
- b:=true;
- end;
- until (i>=length(el1)) and (j>=length(el2)); *)
-
for i:=0 to length(el1)-1 do begin
k:=-1;
for j:=0 to length(el2)-1 do
@@ -915,19 +906,6 @@ begin
setlength(cRefPuls,anz);
end;
-function shellSubst(s: string): string;
-var name: string;
-begin
- result:=s;
- while pos('${',result)>0 do begin
- s:=leftStr(result,pos('${',result)-1);
- delete(result,1,pos('${',result)-1+length('${'));
- name:=leftStr(result,pos('}',result)-1);
- delete(result,1,length(name+'}'));
- result:=s+GetEnvironmentVariable(name)+result;
- end;
-end;
-
// tSortThread *****************************************************************
constructor tSortThread.create(pd: pTExtPointArray; sta, sto: longint);
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-21 17:49:52 +0000