program ROM; {$DEFINE UseCThreads} {$mode objfpc}{$H+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes { you can add units after this }, SysUtils,ROMunit, matheunit, Math; 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; //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]'; const Verwendung='Verwendung: ROM $Parameterdatei'; begin if (paramcount<>1) or not fileexists(paramstr(1)) then Fehler(Verwendung); force:=false; smooth:=1; betaSmooth:=1; tmax:=-1; wmax:=-1; absShift:=-1e9; betaBound:=0.95; fourier:=false; mitAmplMod:=true; lpicIn:=''; rohIn:=''; rohRef:=''; outIn:=''; outRef:=''; outRefC:=''; outSur:=''; assignfile(f,paramstr(1)); reset(f); while not eof(f) do begin readln(f,s); s:=shellSubst(s); if pos('#',s)>0 then delete(s,pos('#',s),length(s)); s:=trim(s); if s='' then continue; if pos('?',s)=1 then begin delete(s,1,1); t:=trim(leftStr(s,pos('=',s)-1)); delete(s,1,pos('=',s)); u:=trim(leftStr(s,pos(':',s)-1)); delete(s,1,pos(':',s)); s:=trim(s); if t<>u then continue; end; if s='mit Gewalt' then begin force:=true; continue; end; if s='ohne Gewalt' then begin force:=false; continue; end; if s='mit Amplitudenmodulation' then begin mitAmplMod:=true; continue; end; if (s='ohne Amplitudenmodulation') or (s='nur Phasenmodulation') then begin mitAmplMod:=false; continue; end; if pos('Glätte:',s)=1 then begin delete(s,1,pos(':',s)); s:=trim(s); smooth:=strtoint(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 delete(s,1,pos(':',s)); s:=trim(s); betaBound:=strtofloat(s); continue; end; if pos('tmax:',s)=1 then begin delete(s,1,pos(':',s)); s:=trim(s); tmax:=strtofloat(s); continue; end; if (pos('wmax:',s)=1) or (pos('ωmax:',s)=1) then begin delete(s,1,pos(':',s)); s:=trim(s); wmax:=strtofloat(s); continue; end; if (pos('Absolutverschiebung:',s)=1) then begin delete(s,1,pos(':',s)); s:=trim(s); if s='auto' then begin absShift:=-1e9; continue; end; if s='input' then begin absShift:=-2e9; continue; end; absShift:=strtofloat(s); continue; end; if s='mit FFT' then begin fourier:=true; continue; end; if s='ohne FFT' then begin fourier:=false; continue; end; if pos('lpic-Quelle:',s)=1 then begin delete(s,1,pos(':',s)); lpicIn:=trim(s); continue; end; if pos('in-Quelle:',s)=1 then begin delete(s,1,pos(':',s)); rohIn:=trim(s); continue; end; if pos('reflex-Quelle:',s)=1 then begin delete(s,1,pos(':',s)); rohRef:=trim(s); continue; end; if pos('in-Ziel:',s)=1 then begin delete(s,1,pos(':',s)); outIn:=trim(s); continue; end; if pos('reflex-Ziel:',s)=1 then begin delete(s,1,pos(':',s)); outRef:=trim(s); continue; end; if pos('reflex-Approx-Ziel:',s)=1 then begin delete(s,1,pos(':',s)); outRefC:=trim(s); continue; end; if pos('trajektorie-Ziel:',s)=1 then begin delete(s,1,pos(':',s)); outSur:=trim(s); continue; end; Fehler('Unbekannter Parameter '''+s+''' in Inputdatei '''+paramstr(1)+'''!'); end; closefile(f); if (absShift<-1.5e9) and (lpicIn='') then Fehler('Ich brauche zur Bestimmung der Gesamtverschiebung die Inputdatei vom LPIC!'); if (lpicIn<>'') and ((rohIn<>'') or (rohRef<>'')) then Fehler('lpic-Quelle und rohe Input-/Reflex-Quelle können nicht gleichzeitig angegeben werden!'); if ((rohIn<>'') xor (rohRef<>'')) then Fehler('Ich brauche den rohen Input- und Reflex-Puls, oder aber nur die lpic-Quelle!'); if (not force) and (outIn<>'') and fileexists(outIn+'.ori') then Fehler('Die Ausgabedatei '''+outIn+'.ori'' existiert bereits!'); if (not force) and (outIn<>'') and fileexists(outIn) then Fehler('Die Ausgabedatei '''+outIn+''' existiert bereits!'); if (not force) and (outRef<>'') and fileexists(outRef+'.ori') then Fehler('Die Ausgabedatei '''+outRef+'.ori'' existiert bereits!'); if (not force) and (outRef<>'') and fileexists(outRef) then Fehler('Die Ausgabedatei '''+outRef+''' existiert bereits!'); if (not force) and (outRefC<>'') and fileexists(outRefC) then Fehler('Die Ausgabedatei '''+outRefC+''' existiert bereits!'); if (not force) and (outSur<>'') and fileexists(outSur) then Fehler('Die Ausgabedatei '''+outSur+''' existiert bereits!'); if lpicIn<>'' then readRawInputs(lpicIn,inPulsO,refPulsO,absShift) else begin readTextInput(rohIn,inPulsO); readTextInput(rohRef,refPulsO); end; write(stderr,'Input sortieren ...'); sort(inPulsO); sort(refPulsO); writeln(stderr,' fertig'); uniq(inPulsO,false); uniq(refPulsO,false); write(stderr,'Input interpolieren ...'); interpoliere(inPulsO); interpoliere(refPulsO); writeln(stderr,' fertig'); flip(inPulsO); if mitAmplMod then begin integrate(inPulsO,inPuls); integrate(refPulsO,refPuls); end else begin copyArray(inPulsO,inPuls); copyArray(refPulsO,refPuls); end; removeLinearOffset(inPuls); removeLinearOffset(refPuls); if smooth>1 then begin write(stderr,'glätten ...'); smoothen(inPuls,smooth); smoothen(refPuls,smooth); writeln(stderr,' fertig'); end; cut(inPuls,tmax); cut(refPuls,tmax); gesamtverschiebung(inPuls,refPuls,absShift); write(stderr,'Trajektorie berechnen ...'); berechneTrajektorie(inPuls,refPuls,surTraj,absShift*byte(not fourier)); writeln(stderr,' fertig'); write(stderr,'Ergebnis sortieren ...'); sort(surTraj); writeln(stderr,' fertig'); uniq(surTraj,false); write(stderr,'Reflektierten Puls berechnen ...'); berechneRefPuls(inPulsO,surTraj,betaSmooth,betaBound,cRefPuls); writeln(stderr,' fertig'); if fourier then begin write(stderr,'Ergebnis interpolieren ...'); interpoliere(surTraj); writeln(stderr,' fertig'); fft(inPuls); fft(refPuls); fft(surTraj); inPuls[0].y:=0; refPuls[0].y:=0; surTraj[0].y:=0; if wmax<0 then 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); end else begin cut(surTraj,wmax); cut(inPuls,wmax); cut(refPuls,wmax); end; write(stderr,'alles normieren ...'); normiere(inPuls); normiere(refPuls); normiere(surTraj); writeln(stderr,' fertig'); end; if outIn<>'' then begin writeOutput(outIn+'.ori',inPulsO); writeOutput(outIn,inPuls); end; if outRef<>'' then begin writeOutput(outRef+'.ori',refPulsO); writeOutput(outRef,refPuls); end; if outSur<>'' then writeOutput(outSur,surTraj); if outRefC<>'' then writeOutput(outRefC,cRefPuls); end.