// 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,true); 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_radonTransformationsLineOut} //procedure tLLWerte.radonTransformationsLineOut(xMin,xMax: longint; qu: pTLLWerteSingle); var oX,oY,iXG,iYG: int64; cX,sX,iX,iY,iXF,iYF: extended; begin // y-doResSmi-georndeter Wert an Stelle (oX,oY) soll gefüllt werden mit // x-&y-doResSmi-geornetem Wert auf der Ursprungsgerade mit Winkel oX*XStep; Position oY*yStep // Wir gehen davon aus, dass das Feld groß genug ist, sodass wir die Mitte nicht erreichen. for oX:=xMin to xMax do begin cX:=sin((oX/params.xSteps-1/2)*pi); sX:=-cos((oX/params.xSteps-1/2)*pi); for oY:=0 to params.tSiz div 2 do begin iX:=oY*cX; iY:=oY*sX; iXG:=floor(iX); iXF:=iX-iXG; iYG:=floor(iY); iYF:=iY-iYG; // alternierendes Vorzeichen außen (oY) <=> Ergebnisse zentrieren // alternierendes Vorzeichen innen (iXG,iYG) <=> Eingangsdaten zentriert werte[oX+oY*params.xSteps]:=(1-2*byte(odd(oY+iXG+iYG))) * ( qu^.reBei2DDoResSmi(iXG,iYG)*(1-iXF)*(1-iYF) - qu^.reBei2DDoResSmi(iXG+1,iYG)*iXF*(1-iYF) - qu^.reBei2DDoResSmi(iXG,iYG+1)*(1-iXF)*iYF + qu^.reBei2DDoResSmi(iXG+1,iYG+1)*iXF*iYF); if (oY>0) and (2*oYdoRes) 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}