diff options
| -rw-r--r-- | epost.lpr | 27 | ||||
| -rw-r--r-- | epost.lps | 132 | ||||
| -rw-r--r-- | epostunit.pas | 502 |
3 files changed, 515 insertions, 146 deletions
@@ -211,6 +211,33 @@ begin aufraeumen; halt(1); end; + if startetMit('Multipliziere',s) then begin + i:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); + if i<0 then begin + aufraeumen; + halt(1); + end; + if (not startetMit('mal ',s)) or (length(s)=0) then begin + gibAus('Fehlende Parameter, erwartet: ''Multipliziere $Faktor mal $Faktor (zu $Produkt)''',3); + aufraeumen; + halt(1); + end; + j:=findeWerte(erstesArgument(s),@wertes,@Konturen,false); + if j<0 then begin + aufraeumen; + halt(1); + end; + b:=not startetMit('zu',s); + k:=findeWerte(s,@wertes,@Konturen,b); + if k<0 then begin + aufraeumen; + halt(1); + end; + if wertes[k].berechneProdukt(syntaxtest,inf,maxthreads,i,j) then + continue; + aufraeumen; + halt(1); + end; if startetMit('FFT2d',s) then begin if s='' then i:=length(wertes)-1 else i:=findeWerte(s,@wertes,@Konturen,false); @@ -7,8 +7,9 @@ <Unit0> <Filename Value="epost.lpr"/> <IsPartOfProject Value="True"/> - <TopLine Value="229"/> - <CursorPos X="46" Y="50"/> + <TopLine Value="125"/> + <CursorPos Y="214"/> + <FoldState Value=" T0iRVB011171221211]B9[65]E[44]J[O7]CO"/> <UsageCount Value="202"/> <Loaded Value="True"/> </Unit0> @@ -22,9 +23,11 @@ <Unit2> <Filename Value="epostunit.pas"/> <IsPartOfProject Value="True"/> - <EditorIndex Value="2"/> - <CursorPos Y="3"/> - <FoldState Value=" T3og0D5 pigjO078]9XjF0G7[95M0H411 pn4uG0;9[B4k1of0{c]Aj5lg0}54]Abo40{*11[M4Iq10{5[A4OlS0~w0[s58rM0{K5[s5W0jB]J3lZ0F2 pidjJ0c2]RCkF0BB[{x5g0E2]a2kO086]9Rl60W3]aNkM0B8 picjU0z017 piZkU054]9fjH0}^[d46p30L[942jV0K T0j'Q0{1Q"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="1"/> + <TopLine Value="982"/> + <CursorPos X="98" Y="999"/> + <FoldState Value=" T3p70D5 pigjO078]9XjF0G7[95M0H4D p0zB0{n1 pjXmc0{A0a]Kinc0E2 T0kie0{1C"/> <UsageCount Value="201"/> <Loaded Value="True"/> </Unit2> @@ -38,19 +41,16 @@ <Unit4> <Filename Value="werteunit.pas"/> <IsPartOfProject Value="True"/> - <EditorIndex Value="3"/> - <TopLine Value="54"/> + <EditorIndex Value="2"/> <CursorPos X="24" Y="80"/> - <FoldState Value=" T3ib05B piajM0N3 pj1jW041 pmbn20A2 poLob036]RUk40R5]97k30*]RkBm30D1]+ejE071z"/> <UsageCount Value="200"/> <Loaded Value="True"/> </Unit4> <Unit5> <Filename Value="typenunit.pas"/> <IsPartOfProject Value="True"/> - <IsVisibleTab Value="True"/> - <EditorIndex Value="4"/> - <TopLine Value="403"/> + <EditorIndex Value="3"/> + <TopLine Value="444"/> <CursorPos X="28" Y="484"/> <UsageCount Value="200"/> <Loaded Value="True"/> @@ -64,19 +64,17 @@ </Unit6> <Unit7> <Filename Value="../units/mystringlistunit.pas"/> - <EditorIndex Value="1"/> - <TopLine Value="104"/> - <CursorPos Y="104"/> + <EditorIndex Value="-1"/> + <TopLine Value="271"/> + <CursorPos Y="310"/> <UsageCount Value="13"/> - <Loaded Value="True"/> </Unit7> <Unit8> <Filename Value="../units/lowlevelunit.pas"/> - <EditorIndex Value="6"/> - <TopLine Value="416"/> - <CursorPos X="19" Y="436"/> + <EditorIndex Value="-1"/> + <TopLine Value="323"/> + <CursorPos X="19" Y="360"/> <UsageCount Value="13"/> - <Loaded Value="True"/> </Unit8> <Unit9> <Filename Value="../units/randomunit.pas"/> @@ -85,134 +83,120 @@ </Unit9> <Unit10> <Filename Value="../units/matheunit.pas"/> - <EditorIndex Value="5"/> - <TopLine Value="149"/> - <CursorPos X="32" Y="312"/> + <EditorIndex Value="4"/> <UsageCount Value="12"/> <Loaded Value="True"/> </Unit10> </Units> - <JumpHistory Count="30" HistoryIndex="29"> + <JumpHistory Count="27" HistoryIndex="26"> <Position1> <Filename Value="epostunit.pas"/> - <Caret Line="3285" Column="17" TopLine="3265"/> + <Caret Line="4484" Column="15" TopLine="4465"/> </Position1> <Position2> <Filename Value="epostunit.pas"/> - <Caret Line="3286" Column="15" TopLine="3266"/> + <Caret Line="4645" Column="14" TopLine="4622"/> </Position2> <Position3> <Filename Value="epostunit.pas"/> - <Caret Line="3394" Column="15" TopLine="3373"/> + <Caret Line="4729" Column="14" TopLine="4705"/> </Position3> <Position4> - <Filename Value="epostunit.pas"/> - <Caret Line="3421" Column="14" TopLine="3399"/> + <Filename Value="werteunit.pas"/> + <Caret Line="1240" Column="14" TopLine="1036"/> </Position4> <Position5> - <Filename Value="epostunit.pas"/> - <Caret Line="3504" Column="47" TopLine="3505"/> + <Filename Value="werteunit.pas"/> + <Caret Line="332" TopLine="313"/> </Position5> <Position6> - <Filename Value="epostunit.pas"/> - <Caret Line="3711" Column="14" TopLine="3690"/> + <Filename Value="werteunit.pas"/> + <Caret Line="345" Column="69" TopLine="321"/> </Position6> <Position7> - <Filename Value="epostunit.pas"/> - <Caret Line="3822" Column="14" TopLine="3801"/> + <Filename Value="werteunit.pas"/> + <Caret Line="413" Column="12" TopLine="393"/> </Position7> <Position8> <Filename Value="epostunit.pas"/> - <Caret Line="3858" Column="28" TopLine="3838"/> + <Caret Line="4763" Column="19" TopLine="4732"/> </Position8> <Position9> <Filename Value="epostunit.pas"/> - <Caret Line="3887" Column="21" TopLine="3867"/> + <Caret Line="384" Column="4" TopLine="365"/> </Position9> <Position10> <Filename Value="epostunit.pas"/> - <Caret Line="3917" Column="21" TopLine="3897"/> + <Caret Line="4763" Column="17" TopLine="4731"/> </Position10> <Position11> <Filename Value="epostunit.pas"/> - <Caret Line="4054" Column="17" TopLine="4031"/> + <Caret Line="978" Column="29" TopLine="965"/> </Position11> <Position12> <Filename Value="epostunit.pas"/> - <Caret Line="4432" Column="15" TopLine="4411"/> + <Caret Line="4691" Column="32" TopLine="4653"/> </Position12> <Position13> - <Filename Value="epostunit.pas"/> - <Caret Line="4482" Column="19" TopLine="4455"/> + <Filename Value="werteunit.pas"/> + <Caret Line="514" Column="45" TopLine="496"/> </Position13> <Position14> <Filename Value="epostunit.pas"/> - <Caret Line="4487" Column="44" TopLine="4458"/> + <Caret Line="125" Column="30" TopLine="118"/> </Position14> <Position15> <Filename Value="epostunit.pas"/> - <Caret Line="4475" Column="30" TopLine="4455"/> + <Caret Line="1877" Column="12" TopLine="1846"/> </Position15> <Position16> <Filename Value="epostunit.pas"/> - <Caret Line="4484" Column="15" TopLine="4465"/> + <Caret Line="1799" Column="37" TopLine="1779"/> </Position16> <Position17> <Filename Value="epostunit.pas"/> - <Caret Line="4645" Column="14" TopLine="4622"/> + <Caret Line="192" Column="18" TopLine="173"/> </Position17> <Position18> <Filename Value="epostunit.pas"/> - <Caret Line="4729" Column="14" TopLine="4705"/> + <Caret Line="1713" Column="52" TopLine="1680"/> </Position18> <Position19> - <Filename Value="werteunit.pas"/> - <Caret Line="1240" Column="14" TopLine="1036"/> + <Filename Value="epostunit.pas"/> + <Caret Line="1789" Column="40" TopLine="1757"/> </Position19> <Position20> - <Filename Value="werteunit.pas"/> - <Caret Line="332" TopLine="313"/> + <Filename Value="epostunit.pas"/> + <Caret Line="3832" Column="24" TopLine="3797"/> </Position20> <Position21> - <Filename Value="../units/lowlevelunit.pas"/> - <Caret Line="37" Column="44"/> + <Filename Value="epostunit.pas"/> + <Caret Line="3674" TopLine="3664"/> </Position21> <Position22> - <Filename Value="../units/lowlevelunit.pas"/> - <Caret Line="436" Column="10" TopLine="416"/> + <Filename Value="epostunit.pas"/> + <Caret Line="3867" TopLine="3828"/> </Position22> <Position23> - <Filename Value="werteunit.pas"/> - <Caret Line="345" Column="69" TopLine="321"/> + <Filename Value="epostunit.pas"/> + <Caret Line="3884" Column="10" TopLine="3863"/> </Position23> <Position24> - <Filename Value="werteunit.pas"/> - <Caret Line="413" Column="12" TopLine="393"/> + <Filename Value="epostunit.pas"/> + <Caret Line="1826" Column="18" TopLine="1819"/> </Position24> <Position25> <Filename Value="epostunit.pas"/> - <Caret Line="4763" Column="19" TopLine="4732"/> + <Caret Line="1003" Column="69" TopLine="984"/> </Position25> <Position26> - <Filename Value="epostunit.pas"/> - <Caret Line="384" Column="4" TopLine="365"/> + <Filename Value="../units/matheunit.pas"/> + <Caret Line="312" Column="32" TopLine="272"/> </Position26> <Position27> <Filename Value="epostunit.pas"/> - <Caret Line="4763" Column="17" TopLine="4731"/> + <Caret Line="1004" Column="26" TopLine="982"/> </Position27> - <Position28> - <Filename Value="epostunit.pas"/> - <Caret Line="978" Column="29" TopLine="965"/> - </Position28> - <Position29> - <Filename Value="epostunit.pas"/> - <Caret Line="4691" Column="32" TopLine="4653"/> - </Position29> - <Position30> - <Filename Value="werteunit.pas"/> - <Caret Line="514" Column="45" TopLine="496"/> - </Position30> </JumpHistory> </ProjectSession> </CONFIG> diff --git a/epostunit.pas b/epostunit.pas index cac1513..892d43d 100644 --- a/epostunit.pas +++ b/epostunit.pas @@ -123,6 +123,7 @@ type function ladeAscii(st: boolean; datei: string): boolean; function berechneLiKo(st: boolean; var f: tMyStringlist; threads: longint): boolean; function berechneQuotient(st: boolean; var f: tMyStringlist; threads, dividend, divisor: longint): boolean; + function berechneProdukt(st: boolean; var f: tMyStringlist; threads, faktor1, faktor2: longint): boolean; function berechneKorrelation(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte): boolean; procedure ermittleMinMaxDichten(st: boolean; threads: longint; symmetrisch: boolean); overload; procedure ermittleMinMaxDichten(st: boolean; threads,xmin,xmax,tmin,tmax: longint; symmetrisch: boolean); overload; @@ -196,6 +197,13 @@ type destructor destroy; override; procedure stExecute; override; end; + tProduktThread = class(tLogThread) + xMi,xMa,tMi,tMa,tOf,xOf: longint; + f1,f2,pro: tWerte; + constructor create(faktor1, faktor2, produkt: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); + destructor destroy; override; + procedure stExecute; override; + end; tBilderthread = class(tLogThread) nummer,mt,breite,wbreite,hoehe, whoehe,gesbreite,lof,oof,rof,uof: longint; @@ -992,7 +1000,7 @@ begin genauigkeit:=gSingle; for i:=0 to length(dateien)-1 do - genauigkeit:=tGenauigkeit(max(byte(genauigkeit),byte(dateien[i].genauigkeit))); + genauigkeit:=tGenauigkeit(max(genauigkeit,dateien[i].genauigkeit)); tmpi:=0; num:=0; tmps:=0; @@ -1791,6 +1799,93 @@ begin result:=true; end; +function tWerte.berechneProdukt(st: boolean; var f: tMyStringlist; threads, faktor1, faktor2: longint): boolean; +var i,xmin,xmax,tmin,tmax: longint; + s: string; + fertig: boolean; + produktThreads: array of tProduktThread; + Zeit: extended; +begin + result:=false; + warteaufBeendigungDesLeseThreads; + Zeit:=now; + Transformationen.kopiereVon(wertes^[faktor1].Transformationen); + _xsteps:=wertes^[faktor1]._xsteps; + xmin:=0; + xmax:=_xsteps-1; + _tsiz:=wertes^[faktor1]._tsiz; + tmin:=0; + tmax:=_tsiz-1; + _np:=wertes^[faktor1]._np; + _beta:=wertes^[faktor1]._beta; + Zeit:=now; + repeat + if not f.readln(s) then begin + gibAus('Unerwartetes Dateiende!',3); + exit; + end; + if s='Ende' then break; + if startetMit('Name:',s) then begin + bezeichner:=s; + continue; + end; + if startetMit('xmin:',s) then begin + xmin:=kont2disk('x',exprtofloat(st,s)); + continue; + end; + if startetMit('xmax:',s) then begin + xmax:=kont2disk('x',exprtofloat(st,s)); + continue; + end; + if startetMit('tmin:',s) then begin + tmin:=kont2disk('t',exprtofloat(st,s)); + continue; + end; + if startetMit('tmax:',s) then begin + tmax:=kont2disk('t',exprtofloat(st,s)); + continue; + end; + gibAus('Verstehe Option '''+s+''' nicht bei Multipliziere!',3); + exit; + until false; + + _xsteps:=xmax-xmin+1; + _tsiz:=tmax-tmin+1; + if (wertes^[faktor1].Transformationen.xstart<>wertes^[faktor2].Transformationen.xstart) or + (wertes^[faktor1].Transformationen.xstop<>wertes^[faktor2].Transformationen.xstop) or + (wertes^[faktor1].Transformationen.tstart<>wertes^[faktor2].Transformationen.tstart) or + (wertes^[faktor1].Transformationen.tstop<>wertes^[faktor2].Transformationen.tstop) or + (wertes^[faktor1]._xsteps<>wertes^[faktor2]._xsteps) or + (wertes^[faktor1]._tsiz<>wertes^[faktor2]._tsiz) then begin + gibAus('Faktor1 und Faktor2 haben verschiedene Abmessungen, sowas verstehe ich nicht!',3); + exit; + end; + Transformationen.addAusschnitt(xmin,xmax,tmin,tmax); + _np:=wertes^[faktor1]._np; + _beta:=wertes^[faktor1]._beta; + Genauigkeit:=gExtended; + if st then begin + result:=true; + exit; + end; + eWerte.holeRam(3); + gibAus('Berechne ...',3); + Zeit:=now; + setlength(produktThreads,threads); + for i:=0 to length(produktThreads)-1 do + produktThreads[i]:=tProduktThread.create(wertes^[faktor1],wertes^[faktor2],self,round(i*_xsteps/threads),round((i+1)*_xsteps/threads-1),0,_tsiz-1,xmin,tmin); + repeat + sleep(100); + fertig:=true; + for i:=0 to length(produktThreads)-1 do + fertig:=fertig and produktThreads[i].fertig; + until fertig; + for i:=0 to length(produktThreads)-1 do + produktThreads[i].free; + gibAus('... fertig '+timetostr(now-Zeit),3); + result:=true; +end; + function tWerte.berechneKorrelation(st: boolean; var f: tMyStringlist; threads: longint; const quelle: tWerte): boolean; var i,xmin,xmax,tmin,tmax: longint; s: string; @@ -3570,81 +3665,344 @@ begin end; procedure tQuotientThread.stExecute; -var i,j: longint; - i0,o0: boolean; +var i,j: longint; + i01,i02,o0: boolean; begin gibAus('Quotient-Berechnungsthread gestartet ...',1); - i0:=true; + i01:=true; + i02:=true; o0:=true; - case 2*byte(sor.Genauigkeit)+byte(dend.Genauigkeit) of - 0: // single / single - for j:=tMi to tMa do begin - if (tMa-j) mod ((tMa-tMi) div 10) = 0 then - gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); - for i:=xMi to xMa do - if abs(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - eps*sign(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) - else - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; - i0:=i0 and (sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); - o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); - end; - 1: // double / single - for j:=tMi to tMa do begin - if (tMa-j) mod ((tMa-tMi) div 10) = 0 then - gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); - for i:=xMi to xMa do - if abs(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - eps*sign(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) - else - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; - i0:=i0 and (sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); - o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); - end; - 2: // single / double - for j:=tMi to tMa do begin - if (tMa-j) mod ((tMa-tMi) div 10) = 0 then - gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); - for i:=xMi to xMa do begin - if abs(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - eps*sign(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) - else - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; - i0:=i0 and (sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); - o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); - end; - end; - 3: // double / double - for j:=tMi to tMa do begin - if (tMa-j) mod ((tMa-tMi) div 10) = 0 then - gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); - for i:=xMi to xMa do begin - if abs(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - eps*sign(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) - else - quot.eWerte.werte[i+j*quot._xsteps]:= - dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / - sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; - i0:=i0 and (sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); - o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); - end; - end; + case dend.Genauigkeit of + gSingle: + case sor.Genauigkeit of + gSingle: // single / single + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + if abs(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + gDouble: // single / double + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + if abs(sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + end; + gExtended: // single / extended + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + if abs(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.sWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + end; + end{of case}; + gDouble: + case sor.Genauigkeit of + gSingle: // double / single + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + if abs(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + gDouble: // double / double + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + if abs(sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + end; + gExtended: // double / extended + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + if abs(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.dWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + end; + end{of case}; + gExtended: + case sor.Genauigkeit of + gSingle: // extended / single + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + if abs(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.sWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + gDouble: // extended / double + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + if abs(sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.dWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + end; + gExtended: // extended / extended + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Quotient-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do begin + if abs(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps])<eps then + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + eps*sign(sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]) + else + quot.eWerte.werte[i+j*quot._xsteps]:= + dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps] / + sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]; + i01:=i01 and (dend.eWerte.werte[(xOf+i) + (tOf+j)*dend._xsteps]=0); + i02:=i02 and (sor.eWerte.werte[(xOf+i) + (tOf+j)*sor._xsteps]=0); + o0:=o0 and (quot.eWerte.werte[i+j*quot._xsteps]=0); + end; + end; + end{of case}; + end{of Case}; + if i01 then gibAus('Nur Nullen im Dividend-Input!',1); + if i02 then gibAus('Nur Nullen im Divisor-Input!',1); + if o0 then gibAus('Nur Nullen im Output!',1); + gibAus('... und fertig!',1); + fertig:=true; +end; + +// tProduktThread ************************************************************* + +constructor tProduktThread.create(faktor1, faktor2, produkt: tWerte; xMin,xMax,tMin,tMax,xOff,tOff: longint); +begin + inherited create; + f1:=faktor1; + f2:=faktor2; + pro:=produkt; + xMi:=xMin; + xMa:=xMax; + tMi:=tMin; + tMa:=tMax; + tOf:=tOff; + xOf:=xOff; + gibAus('Starte Produkt-Berechnungsthread!',1); + suspended:=false; +end; + +destructor tProduktThread.destroy; +begin + inherited destroy; +end; + +procedure tProduktThread.stExecute; +var i,j: longint; + i01,i02,o0: boolean; +begin + gibAus('Produkt-Berechnungsthread gestartet ...',1); + i01:=true; + i02:=true; + o0:=true; + + case f1.Genauigkeit of + gSingle: + case f2.Genauigkeit of + gSingle: // single * single + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.sWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.sWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.sWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.sWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + gDouble: // single * double + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.sWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.dWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.sWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.dWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + gExtended: // single * extended + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.sWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.eWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.sWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.eWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + end{of case}; + gDouble: + case f2.Genauigkeit of + gSingle: // double * single + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.dWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.sWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.dWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.sWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + gDouble: // double * double + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.dWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.dWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.dWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.dWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + gExtended: // double * extended + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.dWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.eWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.dWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.eWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + end{of case}; + gExtended: + case f2.Genauigkeit of + gSingle: // extended * single + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.eWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.sWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.eWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.sWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + gDouble: // extended * double + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.eWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.dWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.eWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.dWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + gExtended: // extended * extended + for j:=tMi to tMa do begin + if (tMa-j) mod ((tMa-tMi) div 10) = 0 then + gibAus('Produkt-Berechnungsthread: '+inttostr(j)+'/'+inttostr(tMi)+'..'+inttostr(tMa)+' ('+inttostr(xMi)+'..'+inttostr(xMa)+')',1); + for i:=xMi to xMa do + pro.eWerte.werte[i+j*pro._xsteps]:= + f1.eWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps] * + f2.eWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]; + i01:=i01 and (f1.eWerte.werte[(xOf+i) + (tOf+j)*f1._xsteps]=0); + i02:=i02 and (f2.eWerte.werte[(xOf+i) + (tOf+j)*f2._xsteps]=0); + o0:=o0 and (pro.eWerte.werte[i+j*pro._xsteps]=0); + end; + end{of case}; end{of Case}; - if i0 then gibAus('Nur Nullen im Input!',1); + + if i01 then gibAus('Nur Nullen im 1.Faktor-Input!',1); + if i02 then gibAus('Nur Nullen im 2.Faktor-Input!',1); if o0 then gibAus('Nur Nullen im Output!',1); gibAus('... und fertig!',1); fertig:=true; |