// repetitive includes for werteunit.pas {$IFDEF tLLWerte_create} //constructor tLLWerte.create(original: pTLLWerteSingle; ps: tExtraInfos; xMin,xMax: longint); begin inherited create; params:=ps; kopiereVon(false,original,xMin,xMax); end; {$ENDIF} {$IFDEF tLLWerte_kopiereVon} //procedure tLLWerte.kopiereVon(sT: boolean; original: pTLLWerteSingle); begin kopiereVon(sT,original,0,original^.params.xSteps-1); end; {$ENDIF} {$IFDEF tLLWerte_kopiereVon_xMiMa} //procedure tLLWerte.kopiereVon(sT: boolean; original: pTLLWerteSingle; xMin,xMax: longint); begin kopiereVon(sT,original,xMin,xMax,0,original^.params.tSiz-1); end; {$ENDIF} {$IFDEF tLLWerte_kopiereVon_xTMiMa} //procedure tLLWerte.kopiereVon(sT: boolean; original: pTLLWerteSingle; xMin,xMax,tMin,tMax: longint); var i,j: longint; begin inherited create; params.knownValues.neuerChef(original^.params.knownValues); tMax:=min(tMax,original^.params.tSiz-1); tMin:=max(tMin,0); params.tSiz:=tMax+1-tMin; xMax:=min(xMax,original^.params.xSteps-1); xMin:=max(xMin,0); params.xSteps:=xMax+1-xMin; zerstoereTransformationWennObsolet(params.transformationen); params.transformationen:=tKoordinatenAusschnitt.create(original^.params.transformationen,xMin,xMax,tMin,tMax); params.maxW:=0; params.minW:=0; params.np:=original^.params.np; params.beta:=original^.params.beta; params.refreshKnownValues; if not sT then begin holeRAM(0); for i:=xMin to xMax do for j:=tMin to tMax do werte[i-xMin+(j-tMin)*params.xSteps]:=original^.werte[i+j*original^.params.xSteps]; end; end; {$ENDIF} {$IFDEF tLLWerte_kopiereVonNach} //procedure tLLWerte.kopiereVonNach(original: pTLLWerteSingle; qxmin,qxmax,qtmin,qtmax,zxmin,ztmin: longint); var i,j: longint; begin inherited create; for i:=qxmin to qxmax do for j:=qtmin to qtmax do werte[i-qxmin+zxmin + (j-qtmin+ztmin)*params.xSteps]:= original^.werte[i+j*original^.params.xSteps]; end; {$ENDIF} {$IFDEF tLLWerte_kopiereVerzerrt} //procedure tLLWerte.kopiereVerzerrt(original: pTLLWerteSingle; zPs: tIntPointArray; zGs: tExtPointArray; zAs: tExtendedArray; xMin,xMax,tMin,tMax: longint; vB,nB: tTransformation; vA,nA: longint); var i,j,k: longint; tmp: extended; begin for i:=tMin to tMax do for j:=xMin to xMax do werte[j+i*params.xSteps]:=0; for i:=0 to length(zPs)-1 do for j:=0 to 1 do for k:=0 to 1 do if (zPs[i]['x']+j>=xMin) and (zPs[i]['x']+j<=xMax) and (zPs[i]['y']+k>=tMin) and (zPs[i]['y']+k<=tMax) then begin tmp:=original^.werte[i]; if (vA>0) or (nA>0) then tmp:=(tmp-original^.params.minW)/(original^.params.maxW-original^.params.minW); if vA>0 then vB.transformiereWert(tmp,vA-1); tmp:=tmp * (zGs[i]['x'] * (2*j-1) + 1-j) * (zGs[i]['y'] * (2*k-1) + 1-k); werte[zPs[i]['x']+j + (zPs[i]['y']+k)*params.xSteps]:= werte[zPs[i]['x']+j + (zPs[i]['y']+k)*params.xSteps] + tmp; end; for i:=tMin to tMax do for j:=xMin to xMax do begin tmp:=werte[j + i*params.xSteps] / zAs[j + i*params.xSteps]; if nA>0 then tmp:=nB.transformiereWert(tmp,nA-1); werte[j + i*params.xSteps]:=tmp; end; end; {$ENDIF} {$IFDEF tLLWerte_kopiereLOVerzerrt} //procedure tLLWerte.kopiereLOVerzerrt(original: pTLLWerteSingle; xMin,xMax,tMin,tMax: longint; verhHo,verhVe: extended); var i,j,h,v: int64; hV,hB,vV,vB,xAnteil,yAnteil: extended; begin gibAus(intToStr(xMin)+' .. '+intToStr(xMax)+' x '+intToStr(tMin)+' .. '+intToStr(tMax),1); for i:=tMin to tMax do begin if verhVe>0 then begin vV:= max( 0, (params.tSiz-1-(i+0.5))/ (1 + (i+0.5)/verhVe/(params.tSiz-1))+0.5 ); vB:= min( params.tSiz, (params.tSiz-1-(i-0.5))/ (1 + (i-0.5)/verhVe/(params.tSiz-1))+0.5 ); end else begin vV:=i; // Pixel starten bei i und enden bei i+1 vB:=i+1; end; for j:=xMin to xMax do begin if verhHo>0 then begin hV:= max( 0, (params.xSteps-1-(j+0.5))/ (1 + (j+0.5)/verhHo/(params.xSteps-1))+0.5 ); hB:= min( params.xSteps, (params.xSteps-1-(j-0.5))/ (1 + (j-0.5)/verhHo/(params.xSteps-1))+0.5 ); end else begin hV:=j; hB:=j+1; end; werte[j+i*params.xSteps]:=0; for h:=max(0,floor(hV)) to min(params.xSteps,ceil(hB))-1 do begin xAnteil:=1; if h=floor(hV) then // linker Rand xAnteil:=xAnteil-(hV-h); // hV-h fehlt am ganzen Pixel if h=ceil(hB)-1 then // rechter Rand xAnteil:=xAnteil-(1+h-hB); // 1+h-hB fehlt am ganzen Pixel (1+h ist der rechte Rand des Pixels!) for v:=max(0,floor(vV)) to min(params.tSiz,ceil(vB))-1 do begin yAnteil:=1; // s.o. if v=floor(vV) then yAnteil:=yAnteil-(vV-v); if v=ceil(vB)-1 then yAnteil:=yAnteil-(1+v-vB); werte[j+i*params.xSteps]:= werte[j+i*params.xSteps]+ original^.werte[h+v*original^.params.xSteps]*xAnteil*yAnteil; end; end; if (hB>hV) and (vB>vV) then werte[j+i*params.xSteps]:= werte[j+i*params.xSteps] / (hB-hV) / (vB-vV); end; end; end; {$ENDIF} {$IFDEF tLLWerte_radonTransformation} //procedure tLLWerte.radonTransformation(xMin,xMax: longint; xStep,yStep: extended; qu: pTLLWerteSingle); var oX,oY,iX,iY: longint; oYf,cX,sX,iXM,iYM,oXM,oYM,wert: extended; begin iXM:=(qu^.params.xSteps-1)/2; iYM:=(qu^.params.tSiz-1)/2; oXM:=(params.xSteps-1)/2; oYM:=(params.tSiz-1)/2; for oX:=xMin to xMax do begin cX:=cos((oX-oXM)*xStep); sX:=sin((oX-oXM)*xStep); for oY:=0 to params.tSiz-1 do werte[oX+oY*params.xSteps]:=0; for iY:=0 to qu^.params.tSiz-1 do for iX:=0 to qu^.params.xSteps-1 do begin oYf:=((iX-iXM)*sX + (iY-iYM)*cX) / yStep + oYM; wert:=qu^.werte[iX + iY*qu^.params.xSteps]; if oYf<=0 then werte[oX]:= werte[oX] + wert else if oYf >= params.tSiz-1 then werte[oX + (params.tSiz-1)*params.xSteps]:= werte[oX + (params.tSiz-1)*params.xSteps] + wert else begin oY:=floor(oYf); werte[oX + oY*params.xSteps]:= werte[oX + oY*params.xSteps] + wert * (1-oYf+oY); werte[oX + (oY+1)*params.xSteps]:= werte[oX + (oY+1)*params.xSteps] + wert * (oYf-oY); end; end; end; end; {$ENDIF} {$IFDEF tLLWerte_integriere} //procedure tLLWerte.integriereSingle(qu: pTLLWerteSingle; xMi,xMa,tMi,tMa,xOf,tOf: longint; richtung: tIntegrationsRichtung); var i,j: longint; int,faktor: extended; begin case richtung of irHorizontal: begin faktor:=(qu^.params.xStop-qu^.params.xStart)/(qu^.params.xSteps-1); for i:=tMi to tMa do begin int:=0; for j:=0 to xMi-1 do int:=int+qu^.werte[j + i*qu^.params.xSteps]; for j:=xMi to xMa do begin int:=int+qu^.werte[j + i*qu^.params.xSteps]; werte[j-xOf + (i-tOf)*params.xSteps]:=int*faktor; end; end; end; irEinfall: begin faktor:= sqrt( sqr((qu^.params.xStop-qu^.params.xStart)/(qu^.params.xSteps-1)) + sqr((qu^.params.tStop-qu^.params.tStart)/(qu^.params.tSiz-1))); gibAus('dx = '+floatToStr((qu^.params.xStop-qu^.params.xStart)/(qu^.params.xSteps-1)),1); gibAus('dt = '+floatToStr((qu^.params.tStop-qu^.params.tStart)/(qu^.params.tSiz-1)),1); for i:=tMi to tMa do begin // von links eintretendes (inkl. Ecke links unten) int:=0; for j:=1 to min(xMi,i) do int:=int+qu^.werte[xMi-j + (i-j)*qu^.params.xSteps]; for j:=0 to min(tMa-i,xMa-xMi) do begin int:=int+qu^.werte[xMi+j + (i+j)*qu^.params.xSteps]; werte[j+xMi-xOf + (i+j-tOf)*params.xSteps]:=int*faktor; end; end; for i:=xMi+1 to xMa do begin // von unten eintretendes (exkl. Ecke links unten) int:=0; for j:=1 to min(tMi,i) do int:=int+qu^.werte[i-j + (tMi-j)*qu^.params.xSteps]; for j:=0 to min(tMa-tMi,xMa-i) do begin int:=int+qu^.werte[i+j + (tMi+j)*qu^.params.xSteps]; werte[i+j-xOf + (tMi+j-tOf)*params.xSteps]:=int*faktor; end; end; end; irAusfall: begin faktor:= sqrt( sqr((qu^.params.xStop-qu^.params.xStart)/(qu^.params.xSteps-1)) + sqr((qu^.params.tStop-qu^.params.tStart)/(qu^.params.tSiz-1))); gibAus('dx = '+floatToStr((qu^.params.xStop-qu^.params.xStart)/(qu^.params.xSteps-1)),1); gibAus('dt = '+floatToStr((qu^.params.tStop-qu^.params.tStart)/(qu^.params.tSiz-1)),1); for i:=tMi to tMa do begin // nach links austretendes (inkl. Ecke links oben) int:=0; for j:=1 to min(xMi,qu^.params.tSiz-1-i) do int:=int+qu^.werte[xMi-j + (i+j)*qu^.params.xSteps]; for j:=0 to min(i-tMi,xMa-xMi) do begin int:=int+qu^.werte[xMi+j + (i-j)*qu^.params.xSteps]; werte[j+xMi-xOf + (i-j-tOf)*params.xSteps]:=int*faktor; end; end; for i:=xMi+1 to xMa do begin // nach oben austretendes (exkl. Ecke links oben) int:=0; for j:=1 to min(qu^.params.tSiz-1-tMa,i) do int:=int+qu^.werte[i-j + (tMa+j)*qu^.params.xSteps]; for j:=0 to min(tMa-tMi,xMa-i) do begin int:=int+qu^.werte[i+j + (tMa-j)*qu^.params.xSteps]; werte[i+j-xOf + (tMa-j-tOf)*params.xSteps]:=int*faktor; end; end; end; end{of case}; end; {$ENDIF} {$IFDEF tLLWerte_quotient} // procedure tLLWerte.quotioent(dend: pTLLWerteSingle; sor: pTLLWerteSingle; xMi,xMa,xOf,tMi,tMa,tOf: int64; eps: extended); var i,j: int64; i01,i02,o0: boolean; begin i01:=true; i02:=true; o0:=true; 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(extended(sor^.werte[(xOf+i) + (tOf+j)*sor^.params.xSteps]))doRes) and ( (tMi<0) or (tMa>t2) or (tOf<>0) or (f1^.params.tSiz<>f2^.params.tSiz) or (f1^.params.tSiz<>params.tSiz) or (xMi<0) or (xMa>x2) or (xOf<>0) or (f1^.params.xSteps<>f2^.params.xSteps) or (f1^.params.xSteps<>params.xSteps) ) then fehler('Komplexe Werte kann ich nur in gleichen Abmessungen und vollständig multiplizieren!'); i01:=true; i02:=true; o0:=true; case daO of doRes: 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 begin werte[i+j*params.xSteps]:= f1^.werte[(xOf+i) + (tOf+j)*f1^.params.xSteps] * f2^.werte[(xOf+i) + (tOf+j)*f2^.params.xSteps]; i01:=i01 and (f1^.werte[(xOf+i) + (tOf+j)*f1^.params.xSteps]=0); i02:=i02 and (f2^.werte[(xOf+i) + (tOf+j)*f2^.params.xSteps]=0); o0:=o0 and (werte[i+j*params.xSteps]=0); end; end; doResIms: 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 begin reRe1:=f1^.werte[(xOf+i) + (tOf+j)*f1^.params.xSteps]; reRe2:=f2^.werte[(xOf+i) + (tOf+j)*f2^.params.xSteps]; if (j<>0) and (j<>t2) then begin imRe1:=f1^.werte[(xOf+i) + (tOf+j+t2)*f1^.params.xSteps]; imRe2:=f2^.werte[(xOf+i) + (tOf+j+t2)*f2^.params.xSteps]*(1-2*byte(konj)); // z -> z* bedeutet, dass genau reIm und imRe ihr Vorzeichen ändern end else begin imRe1:=0; imRe2:=0; end; if (i<>0) and (i<>x2) then begin reIm1:=f1^.werte[(xOf+i+x2) + (tOf+j)*f1^.params.xSteps]; reIm2:=f2^.werte[(xOf+i+x2) + (tOf+j)*f2^.params.xSteps]*(1-2*byte(konj)); end else begin reIm1:=0; reIm2:=0; end; if (j<>0) and (j<>t2) and (i<>0) and (i<>x2) then begin imIm1:=f1^.werte[(xOf+i+x2) + (tOf+j+t2)*f1^.params.xSteps]; imIm2:=f2^.werte[(xOf+i+x2) + (tOf+j+t2)*f2^.params.xSteps]; end else begin imIm1:=0; imIm2:=0; end; // | // reRe+imIm + | reRe-imIm + // i*(reIm-imRe) | i*(-reIm-imRe) // | // ------------------------------- // | // reRe-imIm + | reRe+imIm + // i*(reIm+imRe) | i*(-reIm+imRe) // | // Mathematica (komplexe-Matrix-Multiplikation.nb) behauptet: // rR3 -> iI1 iI2 - iR1 iR2 - rI1 rI2 + rR1 rR2 // rI3 -> -iI2 iR1 - iI1 iR2 + rI2 rR1 + rI1 rR2 // iR3 -> -iI2 rI1 - iI1 rI2 + iR2 rR1 + iR1 rR2 // iI3 -> iR2 rI1 + iR1 rI2 + iI2 rR1 + iI1 rR2 werte[i+j*params.xSteps]:=reRe1*reRe2 + imIm1*imIm2 - imRe1*imRe2 - reIm1*reIm2; if (i<>0) and (i<>x2) then begin werte[i+x2+j*params.xSteps]:=-reIm1*imIm2 - imIm1*reIm2 + reRe1*imRe2 + imRe1*reRe2; o0:=o0 and (werte[i+x2+j*params.xSteps]=0); end; if (j<>0) and (j<>t2) then begin werte[i+(j+t2)*params.xSteps]:=-imRe1*imIm2 - imIm1*imRe2 + reRe1*reIm2 + reIm1*reRe2; o0:=o0 and (werte[i+(j+t2)*params.xSteps]=0); if (i<>0) and (i<>x2) then begin werte[i+x2+(j+t2)*params.xSteps]:=reIm1*imRe2 + imRe1*reIm2 + reRe1*imIm2 + imIm1*reRe2; o0:=o0 and (werte[i+x2+(j+t2)*params.xSteps]=0); end; end; i01:=i01 and (reRe1=0) and (imRe1=0) and (reIm1=0) and (imIm1=0); i02:=i02 and (reRe2=0) and (imRe2=0) and (reIm2=0) and (imIm2=0); o0:=o0 and (werte[i+j*params.xSteps]=0); end; end; doResSmi: 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 begin reRe1:=f1^.werte[(xOf+i) + (tOf+j)*f1^.params.xSteps]; reRe2:=f2^.werte[(xOf+i) + (tOf+j)*f2^.params.xSteps]; if (j<>0) and (j<>t2) then begin imRe1:=f1^.werte[(xOf+i) + (tOf-j+2*t2)*f1^.params.xSteps]; imRe2:=f2^.werte[(xOf+i) + (tOf-j+2*t2)*f2^.params.xSteps]*(1-2*byte(konj)); end else begin imRe1:=0; imRe2:=0; end; if (i<>0) and (i<>x2) then begin reIm1:=f1^.werte[(xOf-i+2*x2) + (tOf+j)*f1^.params.xSteps]; reIm2:=f2^.werte[(xOf-i+2*x2) + (tOf+j)*f2^.params.xSteps]*(1-2*byte(konj)); end else begin reIm1:=0; reIm2:=0; end; if (j<>0) and (j<>t2) and (i<>0) and (i<>x2) then begin imIm1:=f1^.werte[(xOf-i+2*x2) + (tOf-j+2*t2)*f1^.params.xSteps]; imIm2:=f2^.werte[(xOf-i+2*x2) + (tOf-j+2*t2)*f2^.params.xSteps]; end else begin imIm1:=0; imIm2:=0; end; // | // reRe+imIm + | reRe-imIm + // i*(reIm-imRe) | i*(-reIm-imRe) // | // ------------------------------- // | // reRe-imIm + | reRe+imIm + // i*(reIm+imRe) | i*(-reIm+imRe) // | // Mathematica (komplexe-Matrix-Multiplikation.nb) behauptet: // rR3 -> iI1 iI2 - iR1 iR2 - rI1 rI2 + rR1 rR2 // rI3 -> -iI2 iR1 - iI1 iR2 + rI2 rR1 + rI1 rR2 // iR3 -> -iI2 rI1 - iI1 rI2 + iR2 rR1 + iR1 rR2 // iI3 -> iR2 rI1 + iR1 rI2 + iI2 rR1 + iI1 rR2 werte[i+j*params.xSteps]:=reRe1*reRe2 + imIm1*imIm2 - imRe1*imRe2 - reIm1*reIm2; if (i<>0) and (i<>x2) then begin werte[-i+2*x2+j*params.xSteps]:=-imRe1*imIm2 - imIm1*imRe2 + reRe1*reIm2 + reIm1*reRe2; o0:=o0 and (werte[-i+2*x2+j*params.xSteps]=0); end; if (j<>0) and (j<>t2) then begin werte[i+(-j+2*t2)*params.xSteps]:=-reIm1*imIm2 - imIm1*reIm2 + reRe1*imRe2 + imRe1*reRe2; o0:=o0 and (werte[i+(-j+2*t2)*params.xSteps]=0); if (i<>0) and (i<>x2) then begin werte[-i+2*x2+(-j+2*t2)*params.xSteps]:=reIm1*imRe2 + imRe1*reIm2 + reRe1*imIm2 + imIm1*reRe2; o0:=o0 and (werte[-i+2*x2+(-j+2*t2)*params.xSteps]=0); end; end; i01:=i01 and (reRe1=0) and (imRe1=0) and (reIm1=0) and (imIm1=0); i02:=i02 and (reRe2=0) and (imRe2=0) and (reIm2=0) and (imIm2=0); o0:=o0 and (werte[i+j*params.xSteps]=0); end; end; else fehler('Produkt ist nicht für Datenordnung '+fftDoToStr(daO)+' implementiert!'); end{of case}; 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); end; {$ENDIF} {$IFDEF tLLWerte_fenstereWerte_fensterMultiplikation} for j:=tMi to tMa do for i:=xMi to xMa do werte[i+j*params.xSteps]:= ( werte[i+j*params.xSteps] {$IFDEF hatOffset} -offset {$ENDIF} ) {$IFDEF hatXFenster} *xFen.werte[i] {$ENDIF} {$IFDEF hatTFenster} *tFen.werte[j] {$ENDIF} ; {$ENDIF}