diff options
Diffstat (limited to 'romunit.pas')
| -rw-r--r-- | romunit.pas | 42 |
1 files changed, 38 insertions, 4 deletions
diff --git a/romunit.pas b/romunit.pas index 6bce2e0..ff8ea7c 100644 --- a/romunit.pas +++ b/romunit.pas @@ -10,7 +10,8 @@ uses procedure Fehler(s: string); procedure readRawInputs(nam: string; out d1,d2: tExtPointArray; var absShift: extended); procedure readTextInput(nam: string; out dat: tExtPointArray); -procedure writeOutput(nam: string; const dat: tExtPointArray); +procedure writeOutput(nam: string; const dat: tExtPointArray); overload; +procedure writeOutput(nam: string; const dat,datArg: tExtPointArray); overload; procedure berechneTrajektorie(const inPuls,outPuls: tExtPointArray; out surTraj: tExtPointArray; absShift: extended); procedure smoothen(var dat: tExtPointArray; width: longint); procedure sort(var dat: tExtPointArray); overload; @@ -27,7 +28,7 @@ procedure removeLinearOffset(var dat: tExtPointArray); procedure flip(var dat: tExtPointArray); procedure vereineExtrema(const dat1,dat2: tExtPointArray; var el1,el2: tLongintArray; toleranz: extended); procedure uniq(var dat: tExtPointArray; streng: boolean); -procedure fft(var dat: tExtPointArray); +procedure fft(var dat: tExtPointArray; out datArg: tExtPointArray); procedure interpoliere(var dat: tExtPointArray); procedure normiere(var dat: tExtPointArray); procedure berechneRefPuls(inPuls,surTraj: tExtPointArray; betaGlaette: longint; betaBound: extended; out cRefPuls: tExtPointArray); @@ -284,6 +285,31 @@ begin writeln(stderr,' fertig'); end; +procedure writeOutput(nam: string; const dat,datArg: tExtPointArray); overload; +var f: textfile; + i: longint; +begin + if length(dat)=0 then exit; + if length(dat)<>length(datArg) then + Fehler('dat und datArg haben unterschiedlich viele Werte!'); + write(stderr,'Datei '''+nam+''' schreiben '); + assignfile(f,nam); + rewrite(f); + for i:=0 to length(dat)-1 do begin + if dat[i]['x']<>datArg[i]['x'] then + Fehler('dat und datArg haben unterschiedliche x-Werte an Position '+inttostr(i)+' ('+floattostr(dat[i]['x'])+' vs. '+floattostr(datArg[i]['x'])+')!'); + writeln( + f, + floattostr(dat[i]['x'])+#9+ + floattostr(dat[i]['y'])+#9+ + floattostr(datArg[i]['y']) + ); + if i and 65535 = 0 then write(stderr,'.'); + end; + closefile(f); + writeln(stderr,' fertig'); +end; + procedure berechneTrajektorie(const inPuls,outPuls: tExtPointArray; out surTraj: tExtPointArray; absShift: extended); var i,j: longint; exList: array[0..3] of tLongintArray; @@ -734,14 +760,14 @@ begin setlength(dat,j); end; -procedure fft(var dat: tExtPointArray); +procedure fft(var dat: tExtPointArray; out datArg: tExtPointArray); var i,j,k,n,dist,absch,wnum,wstep,haL: longint; in0,out0: boolean; wRe,wIm: tExtendedArray; t1,t2,vorher,nachher,fstep,pvFehler: extended; umsortierung: tLongintArray; begin - write(stderr,'FFT ... '); + write(stderr,'FFT ('+inttostr(length(dat))+') ... '); fstep:=dat[1]['x']-dat[0]['x']; j:=length(dat); setlength(dat,2*round(power(2,ceil(ln(length(dat))/ln(2))))); @@ -815,9 +841,17 @@ begin dist:=dist*2; end; + setlength(datArg,length(dat)); + + t1:=0; for i:=0 to 2*haL-1 do begin + t2:=arctan2(dat[i]['y'],dat[i]['x']); + t2:=t2-2*pi*round((t2-t1)/2/pi); + datArg[i]['y']:=t2; + t1:=t2; dat[i]['y']:=(sqr(dat[i]['x'])+sqr(dat[i]['y']))/(2*haL); dat[i]['x']:=fStep*i; + datArg[i]['x']:=dat[i]['x']; end; for i:=0 to 2*haL-1 do out0:=out0 and (dat[i]['y']=0); |