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 --- romunit.pas | 68 +++++++++++++++++++++---------------------------------------- 1 file changed, 23 insertions(+), 45 deletions(-) (limited to 'romunit.pas') 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-54-g00ecf