From 82fcb6cc3735015163933de1c25850204fdc7ae5 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Wed, 22 Jul 2015 11:28:13 +0200 Subject: Ausgabe der Oberflächengeschwindigkeit eingebaut MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- ROM.lpi | 2 -- ROM.lpr | 47 ++++++++++++++++++++----- ROM.lps | 113 +++++++++++++++++++++++++++++++----------------------------- romunit.pas | 68 +++++++++++++----------------------- 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 @@ - - 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 @@ - + - - - + + + + - - - - - + + @@ -28,14 +26,14 @@ - + - + @@ -43,127 +41,132 @@ + + + + + + + + - + - + - - + + - - + + - - + + - + - - + + - - + - + - - - + + - + - - + + - - + - - + + - - + + - + - - + + - + - - + + - - + + - + - + - - + + - + - + - + - + - + - + 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(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(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); -- cgit v1.2.3-70-g09d2