produkt kann jetzt auch komplex konjugiert multiplizieren; produkt und quotient in werteunit.inc ausgelagert

1 files changed, 128 insertions, 0 deletions

diff --git a/werteunit.inc b/werteunit.inc
index 832302e..93146b0 100644
--- a/werteunit.inc
+++ b/werteunit.inc
@@ -234,3 +234,131 @@ begin
   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]))<eps then
+        werte[i+j*params.xSteps]:=
+          dend^.werte[(xOf+i) + (tOf+j)*dend^.params.xSteps] /
+          eps*sign(extended(sor^.werte[(xOf+i) + (tOf+j)*sor^.params.xSteps]))
+      else
+        werte[i+j*params.xSteps]:=
+          dend^.werte[(xOf+i) + (tOf+j)*dend^.params.xSteps] /
+          sor^.werte[(xOf+i) + (tOf+j)*sor^.params.xSteps];
+      i01:=i01 and (dend^.werte[(xOf+i) + (tOf+j)*dend^.params.xSteps]=0);
+      i02:=i02 and (sor^.werte[(xOf+i) + (tOf+j)*sor^.params.xSteps]=0);
+      o0:=o0 and (werte[i+j*params.xSteps]=0);
+    end;
+  end;
+  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);
+end;
+{$ENDIF}
+
+{$IFDEF tLLWerte_produkt}
+// procedure tLLWerte.produkt(f1: pTLLWerteSingle; f2: pTLLWerteSingle; xMi,xMa,xOf,tMi,tMa,tOf: int64; konj: boolean; daO: tFFTDatenordnung);
+var
+  i,j,t2:          int64;
+  i01,i02,o0:      boolean;
+  re1,re2,im1,im2: extended;
+begin
+  t2:=params.tSiz div 2;
+  if (daO<>doRes) and (
+    (tMi<>0) or
+    (tMa<>t2) or
+    (tOf<>0) or
+    (f1^.params.tSiz<>f2^.params.tSiz) or
+    (f1^.params.tSiz<>params.tSiz) 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
+          re1:=f1^.werte[(xOf+i) + (tOf+j)*f1^.params.xSteps];
+          re2:=f2^.werte[(xOf+i) + (tOf+j)*f2^.params.xSteps];
+          if (j<>0) and (j<>t2) then begin
+            im1:=f1^.werte[(xOf+i) + (tOf+j+t2)*f1^.params.xSteps];
+            im2:=f2^.werte[(xOf+i) + (tOf+j+t2)*f2^.params.xSteps]*(1-2*byte(konj));
+          end
+          else begin
+            im1:=0;
+            im2:=0;
+          end;
+          werte[i+j*params.xSteps]:=re1*re2+im1*im2;
+          if (j<>0) and (j<>t2) then begin
+            werte[i+(j+t2)*params.xSteps]:=re1*im2+im1*re2; // ansonsten = 0, aber nicht gespeichert
+            o0:=o0 and (werte[i+(j+t2)*params.xSteps]=0);
+          end;
+          i01:=i01 and (re1=0) and (im1=0);
+          i02:=i02 and (re2=0) and (im2=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
+          re1:=f1^.werte[(xOf+i) + (tOf+j)*f1^.params.xSteps];
+          re2:=f2^.werte[(xOf+i) + (tOf+j)*f2^.params.xSteps];
+          if (j<>0) and (j<>t2) then begin
+            im1:=f1^.werte[(xOf+i) + (tOf+2*t2-j)*f1^.params.xSteps];
+            im2:=f2^.werte[(xOf+i) + (tOf+2*t2-j)*f2^.params.xSteps]*(1-2*byte(konj));
+          end
+          else begin
+            im1:=0;
+            im2:=0;
+          end;
+          werte[i+j*params.xSteps]:=re1*re2+im1*im2;
+          if (j<>0) and (j<>t2) then begin
+            werte[i+(2*t2-j)*params.xSteps]:=re1*im2+im1*re2; // ansonsten = 0, aber nicht gespeichert
+            o0:=o0 and (werte[i+(2*t2-j)*params.xSteps]=0);
+          end;
+          i01:=i01 and (re1=0) and (im1=0);
+          i02:=i02 and (re2=0) and (im2=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}