diff options
| -rw-r--r-- | Physikunit.pas | 46 |
1 files changed, 29 insertions, 17 deletions
diff --git a/Physikunit.pas b/Physikunit.pas index 18c0a08..e12f90e 100644 --- a/Physikunit.pas +++ b/Physikunit.pas @@ -1059,30 +1059,42 @@ end; procedure tFelder.nichtnegativieren; // Dichten nicht negativ machen var - i,j,k,l: longint; - defizit: double; + i,j,k,l,m,koo: longint; + defizit: double; + schr,zSchr: array[0..3] of longint; begin + schr[0]:=-aP; + schr[1]:=-1; + schr[2]:=aP; + schr[3]:=1; + for i:=0 to 3 do + zSchr[i]:=schr[(i+1) mod 4] + schr[(i+2) mod 4]; for i:=0 to length(impulsraum)-1 do for j:=0 to aX*aP-1 do if (impulsraum[i,false]+j)^ < 0 then begin defizit:=-(impulsraum[i,false]+j)^; gesamtDefizit:=gesamtDefizit + defizit; (impulsraum[i,false]+j)^:=0; - k:=j; - l:=1; - while (defizit>0) and (l<2*aX*aP) do begin - k:=k+l*(1-2*byte(odd(l))); - inc(l); - if (k<0) or (k>=aX*aP) then continue; - if (impulsraum[i,false]+k)^>defizit then begin - (impulsraum[i,false]+k)^:=(impulsraum[i,false]+k)^-defizit; - defizit:=0; - end - else if (impulsraum[i,false]+k)^>0 then begin - defizit:=defizit-(impulsraum[i,false]+k)^; - (impulsraum[i,false]+k)^:=0; - end; - end; + + for k:=1 to aX+aP do + if defizit>0 then + for l:=0 to 3 do + if defizit>0 then + for m:=0 to k-1 do begin + koo:=j + schr[l]*k + zSchr[l]*m; + if (koo<0) or (koo>=aX*aP) then continue; + + if (impulsraum[i,false]+koo)^>defizit then begin + (impulsraum[i,false]+koo)^:=(impulsraum[i,false]+koo)^-defizit; + defizit:=0; + break; + end + else if (impulsraum[i,false]+koo)^>0 then begin + defizit:=defizit-(impulsraum[i,false]+koo)^; + (impulsraum[i,false]+koo)^:=0; + end; + end; + if defizit>0 then begin gitter.prot.schreibe('Kann Defizit der Teilchensorte '+inttostr(i+1)+' nicht ausgleichen, '+floattostr(defizit)+' bleibt übrig!'); gitter.abbrechen; |