path: root/werteunit.inc

// 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;
  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,hV,hB,vV,vB,h,v: int64;
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,
        round(
          (params.tSiz-1-i+0.5)/
          (1 + (i+0.5)/verhVe/(params.tSiz-1))
        )
      );
      vB:=min(
        params.tSiz-1,
        round(
          (params.tSiz-1-i+0.5)/
          (1 + (i-0.5)/verhVe/(params.tSiz-1))
        )
      );
    end
    else begin
      vV:=i;
      vB:=i;
    end;
    for j:=xMin to xMax do begin
      if verhHo>0 then begin
        hV:=max(
          0,
          round(
            (params.xSteps-1-(j+0.5))/
            (1 + (j+0.5)/verhHo/(params.xSteps-1))
          )
        );
        hB:=min(
          params.xSteps-1,
          round(
            (params.xSteps-1-(j-0.5))/
            (1 + (j-0.5)/verhHo/(params.xSteps-1))
          )
        );
      end
      else begin
        hV:=j;
        hB:=j;
      end;
      werte[j+i*params.xSteps]:=0;
      for h:=hV to hB do
        for v:=vV to vB do
          werte[j+i*params.xSteps]:=
            werte[j+i*params.xSteps]+
            original^.werte[h+v*params.xSteps];
      if (hB>=hV) and (vB>=vV) then
        werte[j+i*params.xSteps]:=
          werte[j+i*params.xSteps] / (hB+1-hV) / (vB+1-vV);
    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]))<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,x2:               int64;
  i01,i02,o0:              boolean;
  reRe1,reRe2,reIm1,reIm2,
  imRe1,imRe2,imIm1,imIm2: extended;
begin
  t2:=params.tSiz div 2;
  x2:=params.xSteps 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
    (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*(imRe-reIm) | i*(-imRe-reIm)
          //               |
          // -------------------------------
          //               |
          // reRe-imIm +   | reRe+imIm +
          // i*(reIm+imRe) | i*(-imRe+reIm)
          //               |

          // 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*(imRe-reIm) | i*(-imRe-reIm)
          //               |
          // -------------------------------
          //               |
          // reRe-imIm +   | reRe+imIm +
          // i*(reIm+imRe) | i*(-imRe+reIm)
          //               |

          // 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]:=-reIm1*imIm2 - imIm1*reIm2 + reRe1*imRe2 + imRe1*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]:=-imRe1*imIm2 - imIm1*imRe2 + reRe1*reIm2 + reIm1*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}