Oto ona cały moduł główny do miejsca gdzie pada kompilacja
unit DSK;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,Printers, Ustawk;
type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
IR,IP,K,LW,N : integer ;
LM,ND,MR,MD,NKZ,NPK,NPM : Array[1..7] of Integer;
ISER : Array[1..12] of Integer;
KX : Array[1..66] of Integer;
CK : real;
P,CS : Array[1..7] of real;
G : Array[1..60] of real; (* było real8 ????)
AK : Array[1..1830] of real;
B,C : Array[1..7,1..20] of real;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormPaint(Sender: TObject);
(*procedure USTAWK(IR,IP,CK,AK); *)
(*procedure USTAWK;
begin
K:=round((IP-1)*IP/2+IP);
AK[K]:=AK[K]+CK ;
K:=round((IR-1)*IR/2+IR);
AK[K]:=AK[K]+CK ;
K:=round((IP-1)IP/2+IR);
AK[K]:=-CK ;
end;)
procedure USWENU;
Var
I1,I2,J,K1,K2,M ,NMD,NND :Integer;
(IWYD : Array[1..12] of Integer;
PK : Real;
BZ,CZ : Array[1..7,1..20] of real;
CPZ : Array[1..7] of real; )
Label 1,3,22 ;
begin
( SUBROUTINE USWENU(LW,LM,ND,MD,MR,CS,KX,NPM,NPK,NKZ,N)
$LARGE
$DEBUG )
( DIMENSION LM(7),ND(7),MD(7),MR(7),CS(7),KX(66),NPM(7),NPK(7),NKZ(7))
K1:=0;
K2:=0;
for I1:=1 to LW do begin
M:=LM[I1];
for I2:=1 to M do begin
K1:=K1+1;
IF(CS[I1]=0.0) and (I2=MR[I1]) then GOTO 1 ;
K2:=K2+1;
KX[K1]:=K2;
IF(I2=MR[I1])then NKZ[I1]:=KX[K1];
GOTO 3;
1: NND:=ND[I1]-1 ;
NMD:=MD[I1];
IF(NND<1) then GOTO 22 ;
(2) for J:=1 to NND do NMD:=NMD+LM[J];
22: KX[K1]:=KX[NMD];
NKZ[I1]:=KX[K1];
3: IF(I2=1) then NPM[I1]:=KX[K1];
(*4 *) IF(I2=LM[I1]) then NPK[I1]:=KX[K1];
(*5 CONTINUE )
end; ( Pętla po I2 )
end; ( Pętla po I1 )
N:=K2 ;
( RETURN
END *)
end;
(procedure REDUKC(LW,LM,MR,MD,ND,B,C,CS,P,AK,KX,NPM,NPK,NKZ,G,N,N1,IWYD(6)))
procedure REDUKC;
Var
I1,I2,IZ,J,J1,K1,K2,K3,L,N1,LMD,LMR,LND :Integer;
IWYD : Array[1..12] of Integer;
PK : Real;
BZ,CZ : Array[1..7,1..20] of real;
CPZ : Array[1..7] of real;
Label 1,2,3,4,5,6,7,8,9,13,15,16 ;
begin (* Procedure REDUKC *)
(* SUBROUTINE REDUKC(LW,LM,MR,MD,ND,B,C,CS,P,AK,KX,NPM,NPK,NKZ,G,N,N1,IWYD8)
DIMENSION LM(7),MR(7),MD(7),ND(7),B(7,20),C(7,20),CS(7),P(7),
AK(1830),KX(66),NPM(7),NPK(7),NKZ(7),G(60),BZ(7,20),CZ(7,20),CPZ(7) *)
IWYD[6]:= ISER[6]; (* dodano - equiwalence *)
for I1:=1 to LW do begin
PK:=P[I1]*P[I1];
L:=LM[I1];
for I2:=1 to L do begin
BZ[I1,I2]:=B[I1,I2]*PK;
IF(I2=LM[I1]) then GOTO 1 ;
CZ[I1,I2]:=C[I1,I2]*PK ;
1: end;
2: CPZ[I1]:=CS[I1]*PK
end;
I1:=LW ;
3: IF(CS[I1]<>0.0) then GOTO 4 ;
K1:=ND[I1];
K2:=MD[I1];
K3:=MR[I1];
BZ[K1,K2]:=BZ[K1,K2]+BZ[I1,K3];
4: I1:=I1-1 ;
IF(I1>1) then GOTO 3;
(*======================================== )
USWENU;
( CALL USWENU(LW,LM,ND,MD,MR,CS,KX,NPM,NPK,NKZ,N) *)
N1:=round((N+1)*N/2) ;
K1:=1;
K:=1;
for I1:=1 to LW do begin (*DO 11 I1=1,LW *)
L:=LM[I1];
for I2:=1 to L do begin (*DO 11 I2=1,L *)
IF(I1<>1) AND (I2=MR[I1]) AND (CS[I1]=0.0 ) then GOTO 5 ;
(* IF(I1.NE.1.AND.I2.EQ.MR(I1).AND.CS(I1).EQ.0.0) GO TO 5 *)
G[K]:=BZ[I1,I2];
K:=K+1;
5: IF(I2=LM[I1]) then GOTO 6 ;
CK:=CZ[I1,I2];
GOTO 7;
6: IF(I1=1) then GOTO 9;
IF(CS[I1]=0.0) then GOTO 9;
CK:=CPZ[I1];
LND:=ND[I1]-1;
LMD:=MD[I1];
LMR:=MR[I1];
IF(LND<1) then GOTO 13;
(*12 *) for J:=1 to LND do LMD:=LMD+LM[J];
13: IF(I1<2) then GOTO 15;
J1:=I1-1;
(14) for J:=1 to J1 do LMR:=LMR+LM[J];
15: IP:=KX[LMR];
IR:=KX[LMD];
GOTO 16;
7: IR:=KX[K1];
IP:=KX[K1+1];
16: IZ:=IR;
IF(IP>=IR) then GOTO 8;
IR:=IP;
IP:=IZ;
8: USTAWK;
(*8: CALL USTAWK(IR,IP,CK,AK) *)
9: K1:=K1+1;
end; (11 CONTINUE - pętla po I2)
end; (11 CONTINUE - pętla po I1)