IMPLEMENTATION MODULE FMatEA;
(*------------------------------------------------------------------------*)
(* Routinen zur Ein- Ausgabe von Vektoren und Matrizen. *)
(* Routines for input and output of Vectors and matrices. *)
(*------------------------------------------------------------------------*)
(* Letzte Bearbeitung : *)
(* *)
(* 12.10.94, MRi: Fehlerkorrekturen. *)
(* 28.07.98, MRi: Einführen der Routine SVKaus. *)
(* 28.10.15, MRi: Umstellen von MATaus auf "open array" Parameter *)
(* 13.04.16, MRi: Umstellen von MatVekaus auf "open array" Parameter *)
(* und Parameter dim,MaxVek auf M,N veraendert *)
(* Ungenutzte Variablen geloescht, Initialisierungs- *)
(* warnungen eliminiert *)
(* 15.04.16, MRi: Modul aus SMatEA neu erzeugt - damit sind die Module *)
(* wieder abgeglichen. Aufwand ca. 15 Minuten ;-) *)
(* 05.05.16, MRi: Prozedur AsymMatEin und PMatEin eingefuegt. *)
(* 18.06.16, MRi: VAL({INTEGER|CARDINAL},TRUNC(x)) durch VAL(Typ,x) und *)
(* lg durch log10 ersetzt *)
(* 04.08.16, MRi: Prozedur WrMatAus eingefuegt *)
(* 13.08.16, MRi: Parameter "trp" in AsymMatEin eingefuegt *)
(* 08.12.16, MRi: Ueberarbeiten der Routine SVKaus *)
(* 19.12.16, MRi: Korrektur bei der Eingabe symmetrischer Matrizen in der *)
(* Prozedur MATein *)
(* 24.07.17, MRi: Komplette Elimination von MATRIX,VEKTOR etc. sowie des *)
(* Record-Type LONGCOMPLEX *)
(* 25.07.17, MRi: Korrektuten in CMATein bezueglich Symmetrieabfrage und *)
(* ueberarbeiten der Routine SVKaus *)
(* 27.07.17, MRi: Umbenennung nach FMatEA (passt besser zu SMatEA) *)
(* 06.07.18, MRi: WrMatConst eingefuegt *)
(*------------------------------------------------------------------------*)
(* Hinweis: Das Modul SMatEA kann aus FMatEA durch folgende Aenderungen *)
(* erzeugt werden *)
(* *)
(* - Ersetzen von FileSystem durch Streams *)
(* - Ersetzen von Close durch CloseStream *)
(* - Globales Ersetzen von "File" durch Stream *)
(* - Globales Ersetzen von "FIO2" durch SIO *)
(* - Ersetzen von EOF durch Ein.EOF *)
(* *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: FMatEA.mod,v 1.8 2017/10/01 07:45:10 mriedl Exp mriedl $ *)
FROM SYSTEM IMPORT TSIZE,ADDRESS;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM StringsLib IMPORT Length,RmMultBlnk;
FROM Deklera IMPORT PMATRIX;
FROM Errors IMPORT Fehler,Fehlerflag,ErrOut,FatalError;
IMPORT Errors;
IMPORT LongComplexMath;
FROM LMathLib IMPORT log10,CardPot;
FROM MatLib IMPORT IJtab;
FROM Strings IMPORT Assign;
FROM DynMat IMPORT AllocMat;
IMPORT TIO;
FROM FileSystem IMPORT File,Close;
FROM FIO2 IMPORT WrChar,WrCharN,WrLn,WrLnN,RdStr,WrStr,WrStrForm,
RdCard,WrCard,RdLngReal,WrLngReal,WrLngCmplx,EOF;
IMPORT FIO2;
FROM MatLib IMPORT MinMaxVek,MinMaxSv;
VAR MZeil : CARDINAL; (* Zeilenz"ahler in MATein. *)
AMZeil : CARDINAL; (* Zeilenz"ahler in AsymMatEin. *)
PZeil : CARDINAL; (* Zeilenz"ahler in PMatEin. *)
CMZeil : CARDINAL; (* Zeilenz"ahler in CMATein. *)
SZeil : CARDINAL; (* Zeilenz"ahler in SVein. *)
CSZeil : CARDINAL; (* Zeilenz"ahler in CSVein. *)
PROCEDURE LesePaare(VAR Ein : File;
VAR X,Y : ARRAY OF LONGREAL;
VAR dim : CARDINAL); (* Anzahl der Datenpaare *)
CONST Protokoll = FALSE; (* Werte auf den Bildschirm ausschreiben ? *)
VAR i : CARDINAL;
BEGIN
i:=0;
LOOP
IF (i > HIGH(X)) OR (i > HIGH(Y)) THEN
Errors.ErrOut('Zuviele Datenpaare (LesePaare) !'); EXIT;
END;
RdLngReal(Ein,X[i]);
IF EOF THEN EXIT END;
IF (X[i] = MAX(LONGREAL)) THEN
Errors.WriteString("Lesefehler in Zeile ");
Errors.WriteInt (i+1);
Errors.WriteString(" in der Datei ");
Errors.WriteString(" ??? "); (* Das kann man besser machen !!! *)
Errors.WriteString(" (SMatEA.LesePaare) !");
Errors.WriteLn;
Errors.FatalError("Programm abgebrochen !");
END;
RdLngReal(Ein,Y[i]);
IF Protokoll THEN
TIO.WrLngReal(X[i],18,9); TIO.WrLngReal(Y[i],18,9); TIO.WrLn;
END;
IF EOF THEN EXIT END;
INC(i);
END; (* LOOP *)
dim:=i;
END LesePaare;
PROCEDURE LeseMat(VAR Ein : File;
VAR Mat : ARRAY OF ARRAY OF LONGREAL;
VAR dim : CARDINAL);
VAR i,j : CARDINAL;
BEGIN
RdCard(Ein,dim);
FOR i:=0 TO dim-1 DO
FOR j:=0 TO dim-1 DO RdLngReal(Ein,Mat[i,j]); END;
END;
END LeseMat;
PROCEDURE LeseSV(VAR Ein : File;
VAR SV : ARRAY OF LONGREAL;
VAR dim : CARDINAL);
VAR i,j,ij : CARDINAL;
BEGIN
RdCard(Ein,dim);
ij:=0;
FOR i:=1 TO dim DO
FOR j:=1 TO i DO RdLngReal(Ein,SV[ij]); INC(ij); END;
END;
END LeseSV;
PROCEDURE LeseMatAus(VAR Ein : File;
VAR Mat : ARRAY OF ARRAY OF LONGREAL;
dim : CARDINAL; (* Dimension der Matrix *)
Spalten : CARDINAL; (* Vektorenanzahl je Block *)
VekAnz : CARDINAL); (* Anzahl der Vektoren *)
VAR MaxBlock,Rest,Block : CARDINAL;
i,j,jj,p,q : CARDINAL;
BEGIN
FOR i:=0 TO dim-1 DO FOR j:=0 TO dim-1 DO Mat[i,j]:=0.0; END; END;
MaxBlock:=VekAnz DIV Spalten;
Rest:=(VekAnz MOD Spalten);
IF (Rest > 0) THEN
INC(MaxBlock);
ELSIF (Rest = 0) THEN
Rest:=VekAnz;
END;
jj:=0;
FOR Block:=1 TO MaxBlock DO
IF (Block < MaxBlock) THEN
FOR q:=1 TO Spalten DO RdCard(Ein,p); END;
ELSE
FOR q:=1 TO Rest DO RdCard(Ein,p); END;
END;
FOR i:=1 TO dim DO
RdCard(Ein,p);
j:=jj;
IF (Block < MaxBlock) THEN
FOR q:=1 TO Spalten DO
INC(j);
RdLngReal(Ein,Mat[j-1,i-1]);
END;
ELSE
FOR q:=1 TO Rest DO
INC(j);
RdLngReal(Ein,Mat[j-1,i-1]);
END;
END; (* IF Block *)
IF EOF AND ((Block < MaxBlock) AND (i < dim)) THEN
ErrOut('Dateiende erreicht (ReadMatAus)');
RETURN;
END;
END; (* FOR i *)
INC(jj,Spalten);
END; (* FOR Block *)
END LeseMatAus;
PROCEDURE Ausgabe(VAR Aus : File;
VAR VEK : ARRAY OF LONGREAL;
Kurzname : ARRAY OF CHAR;
Name : ARRAY OF CHAR;
dim : CARDINAL;
FeldBr : CARDINAL;
Form : CARDINAL);
VAR k,m,leer : CARDINAL;
Exp,Komma : INTEGER;
Min,Max : LONGREAL;
BEGIN
IF (FeldBr > 32) THEN FeldBr:=32; END;
IF (Form = 1) THEN
IF (FeldBr < 9) THEN FeldBr:=9; END;
Komma:= - (VAL(INTEGER,FeldBr) - 8);
IF (FIO2.ExpAnz = 2) THEN DEC(Komma); END;
ELSE
IF (FeldBr < 4) THEN FeldBr:=4; END;
Komma:=FeldBr - 3;
MinMaxVek(Min,Max,VEK,dim,1);
IF (ABS(Max) >= 10.0) THEN
Exp:=VAL(INTEGER,log10(ABS(Max)));
DEC(Komma,Exp);
IF (Komma < 1) THEN Komma:=1; FeldBr:=Exp+4; END;
END;
END;
WrLn(Aus); WrStr(Aus,Name); WrLn(Aus);
FOR k:=1 TO FeldBr + 9 + Length(Kurzname) DO WrChar(Aus,'-'); END;
WrLn(Aus); m:=3;
FOR k:=1 TO dim DO
IF (k > 9 ) THEN m:=2; END;
IF (k > 99) THEN m:=1; END;
WrStr(Aus,Kurzname); WrChar(Aus,'(');
WrCard(Aus,k,1); WrChar(Aus,')');
FOR leer:=1 TO m DO WrChar(Aus,' '); END;
WrStr(Aus,' = ');
WrLngReal(Aus,VEK[k-1],VAL(CARDINAL,FeldBr),Komma);
WrLn(Aus);
END;
WrLn(Aus);
END Ausgabe;
PROCEDURE CAusgabe(VAR Aus : File;
VAR VEK : ARRAY OF LONGCOMPLEX;
Kurzname : ARRAY OF CHAR;
Name : ARRAY OF CHAR;
dim : CARDINAL;
Breite : CARDINAL;
Form : CARDINAL);
VAR k,m,leer : CARDINAL;
Vorz : INTEGER;
BEGIN
IF (Breite > 32) THEN Breite:=32; END;
IF (Form = 1) THEN Vorz:=-1; ELSE Vorz:=1; END;
WrLn(Aus); WrStr(Aus,Name); WrLn(Aus);
FOR k:=1 TO 14 + Length(Kurzname) DO WrChar(Aus,'-'); END;
FOR k:=1 TO 2*Breite DO WrChar(Aus,'-'); END;
WrLn(Aus);
m:=3;
FOR k:=1 TO dim DO
IF (k > 9 ) THEN m:=2; END;
IF (k > 99) THEN m:=1; END;
WrStr(Aus,Kurzname); WrChar(Aus,'(');
WrCard(Aus,k,1); WrChar(Aus,')');
FOR leer:=1 TO m DO WrChar(Aus,' '); END;
WrStr(Aus,' = ');
WrLngReal(Aus,RE(VEK[k-1]),Breite,(Breite-8));
IF (IM(VEK[k-1]) < 0.0) THEN
WrStr(Aus,' - i ');
ELSE
WrStr(Aus,' + i ');
END;
WrLngReal(Aus,ABS(IM(VEK[k-1])),Breite,Vorz*VAL(INTEGER,Breite-8));
WrLn(Aus);
END;
WrLn(Aus);
END CAusgabe;
PROCEDURE EinFehl(VAR Ein : File;
Zeile : CARDINAL;
ProcName : ARRAY OF CHAR); (* Eingabeprozedurname *)
(*-------------------------------------------------------*)
(* Unterroutine zu MATein,SVein,CMATein,CSVein. *)
(* Protokolliert Eingabefehler u. bricht d. Programm ab. *)
(*-------------------------------------------------------*)
BEGIN
TIO.WrLnN(2); TIO.WrStr('Eingabefehler in Zeile '); TIO.WrCard(Zeile,3);
TIO.WrStr(' in der Eingabedatei : '); TIO.WrStr("???"); TIO.WrLnN(2);
TIO.WrStr('Programm abgebrochen ('); TIO.WrStr(ProcName);
TIO.WrStr(') !'); TIO.WrLnN(2);
Close(Ein); HALT;
END EinFehl;
PROCEDURE MATein(VAR Ein : File;
VAR Mat : ARRAY OF ARRAY OF LONGREAL; (* Einzules. MATRIX *)
VAR Name : ARRAY OF CHAR;
VAR dim : CARDINAL; (* dim : Dimension der MATRIX *)
VAR halt : CARDINAL;
sym : CARDINAL);
PROCEDURE MeldFehl; BEGIN EinFehl(Ein,MZeil,'MATein'); END MeldFehl;
VAR mat : LONGREAL;
ind,i,j : CARDINAL;
BEGIN
RdStr(Ein,Name); INC(MZeil);
RdCard(Ein,dim); INC(MZeil);
IF (dim > HIGH(Mat)-1) THEN
ErrOut('Dimension der Matrix zu gro\3 (MATein)');
MeldFehl;
ELSE
FOR i:=0 TO dim-1 DO FOR j:=0 TO dim-1 DO Mat[i,j]:=0.0; END; END;
REPEAT (* Lese von Null verschiedene Matrixelemente *)
INC(MZeil);
RdCard(Ein,i); IF (i = MAX(CARDINAL)) THEN MeldFehl; END;
RdCard(Ein,j); IF (j = MAX(CARDINAL)) THEN MeldFehl; END;
RdLngReal(Ein,mat); IF (mat = MAX(LONGREAL)) THEN MeldFehl; END;
RdCard(Ein,ind); IF (ind = MAX(CARDINAL)) THEN MeldFehl; END;
IF (mat # 0.0) THEN
Mat[i-1,j-1]:=mat;
IF (sym = 1) AND (i # j) THEN
IF (Mat[j-1,i-1] = 0.0) THEN
Mat[j-1,i-1]:=mat;
ELSIF (Mat[j-1,i-1] # mat) THEN
ErrOut('Matrix unsymmetrisch und Parameter sym = 1.');
MeldFehl;
END;
END;
END;
UNTIL (ind=0);
RdCard(Ein,halt); INC(MZeil);
IF (halt = MAX(CARDINAL)) THEN MeldFehl; END;
END; (*ELSE*)
END MATein;
PROCEDURE AsymMatEin(VAR Ein : File;
VAR Mat : ARRAY OF ARRAY OF LONGREAL;
VAR Name : ARRAY OF CHAR;
VAR M : CARDINAL;
VAR N : CARDINAL;
trp : BOOLEAN;
VAR halt : CARDINAL);
PROCEDURE MeldFehl; BEGIN EinFehl(Ein,AMZeil,'MATein'); END MeldFehl;
VAR mat : LONGREAL;
ind,i,j : CARDINAL;
BEGIN
RdStr(Ein,Name); INC(AMZeil);
RdCard(Ein,M); RdCard(Ein,N); INC(AMZeil);
FOR i:=0 TO M-1 DO FOR j:=0 TO N-1 DO Mat[i][j]:=0.0; END; END;
REPEAT (* Lese von Null verschiedene Matrixelemente *)
INC(AMZeil);
RdCard(Ein,i); IF (i = MAX(CARDINAL)) THEN MeldFehl; END;
RdCard(Ein,j); IF (j = MAX(CARDINAL)) THEN MeldFehl; END;
RdLngReal(Ein,mat); IF (mat = MAX(LONGREAL)) THEN MeldFehl; END;
RdCard(Ein,ind); IF (ind = MAX(CARDINAL)) THEN MeldFehl; END;
IF trp THEN
Mat[j-1][i-1]:=mat;
ELSE
Mat[i-1][j-1]:=mat;
END;
UNTIL (ind=0);
RdCard(Ein,halt); INC(AMZeil);
IF (halt = MAX(CARDINAL)) THEN MeldFehl; END;
END AsymMatEin;
PROCEDURE PMatEin(VAR Ein : File;
VAR Mat : PMATRIX;
VAR Name : ARRAY OF CHAR;
VAR M : CARDINAL; (* dim : Dimension der MATRIX *)
VAR N : CARDINAL;
VAR halt : CARDINAL;
alloc : BOOLEAN);
PROCEDURE MeldFehl; BEGIN EinFehl(Ein,PZeil,'MATein'); END MeldFehl;
VAR mat : LONGREAL;
ind,i,j : CARDINAL;
BEGIN
RdStr(Ein,Name); INC(PZeil);
RdCard(Ein,M); RdCard(Ein,N); INC(PZeil);
IF alloc THEN
AllocMat(Mat,M,N);
END;
FOR i:=1 TO M DO FOR j:=1 TO N DO Mat^[i]^[j]:=0.0; END; END;
REPEAT (* Lese von Null verschiedene Matrixelemente *)
INC(PZeil);
RdCard(Ein,i); IF (i = MAX(CARDINAL)) THEN MeldFehl; END;
RdCard(Ein,j); IF (j = MAX(CARDINAL)) THEN MeldFehl; END;
RdLngReal(Ein,mat); IF (mat = MAX(LONGREAL)) THEN MeldFehl; END;
RdCard(Ein,ind); IF (ind = MAX(CARDINAL)) THEN MeldFehl; END;
Mat^[i]^[j]:=mat;
(*
TIO.WrCard(i,3); TIO.WrCard(j,3); TIO.WrLngReal(mat,7,3);
TIO.WrCard(ind,3); TIO.WrLn;
*)
UNTIL (ind=0);
RdCard(Ein,halt); INC(PZeil);
IF (halt = MAX(CARDINAL)) THEN MeldFehl; END;
END PMatEin;
PROCEDURE CMATein(VAR Ein : File;
VAR CMat : ARRAY OF ARRAY OF LONGCOMPLEX;
VAR Name : ARRAY OF CHAR;
VAR dim : CARDINAL; (* dim : Dimension der MATRIX *)
VAR halt : CARDINAL;
sym : CARDINAL);
PROCEDURE MeldFehl; BEGIN EinFehl(Ein,CMZeil,'CMATein'); END MeldFehl;
VAR cmat : RECORD re,im : LONGREAL; END;
ind,i,j : CARDINAL;
BEGIN
RdStr(Ein,Name); INC(CMZeil);
RdCard(Ein,dim); INC(CMZeil);
IF (dim > HIGH(CMat)-1) THEN
ErrOut('Dimension der Matrix zu gro\3 (MATein)');
MeldFehl;
ELSE
FOR i:=0 TO dim-1 DO
FOR j:=0 TO dim-1 DO CMat[i,j]:=CMPLX(0.0,0.0); END;
END;
REPEAT (* Lese von Null verschiedene CMATRIXelemente *)
INC(CMZeil);
RdCard(Ein,i); IF (i = MAX(CARDINAL)) THEN MeldFehl; END;
RdCard(Ein,j); IF (j = MAX(CARDINAL)) THEN MeldFehl; END;
DEC(i); DEC(j);
RdLngReal(Ein,cmat.re);
IF (cmat.re = MAX(LONGREAL)) THEN MeldFehl; END;
RdLngReal(Ein,cmat.im);
IF (cmat.im = MAX(LONGREAL)) THEN MeldFehl; END;
RdCard(Ein,ind); IF (ind = MAX(CARDINAL)) THEN MeldFehl; END;
CMat[i,j]:=CMPLX(cmat.re,cmat.im);
IF (sym = 1) THEN
IF (i # j) AND
(CMat[i,j] # LongComplexMath.conj(CMat[j,i])) AND
(CMat[j,i] # LongComplexMath.zero)
THEN
ErrOut('Matrix unsymmetrisch und Parameter sym = 1.');
MeldFehl;
END;
IF (i # j) THEN CMat[j,i]:=CMPLX(cmat.re,-cmat.im); END;
END;
UNTIL (ind=0);
RdCard(Ein,halt); INC(CMZeil);
IF (halt = MAX(CARDINAL)) THEN MeldFehl; END;
END; (* ELSE *)
END CMATein;
PROCEDURE SVein(VAR Ein : File;
VAR SV : ARRAY OF LONGREAL; (* Einzules. Supervektor *)
VAR Name : ARRAY OF CHAR;
VAR dim : CARDINAL; (* dim : Dimension der MATRIX *)
VAR halt : CARDINAL);
PROCEDURE MeldFehl; BEGIN EinFehl(Ein,SZeil,'SVein'); END MeldFehl;
CONST Protokoll = FALSE; (* Werte auf d. Bildschirm ausschreiben ? *)
VAR sv : LONGREAL;
ind,int,i,j,ij : CARDINAL;
BEGIN
RdStr(Ein,Name); INC(SZeil);
RdCard(Ein,dim); INC(SZeil);
IF (((dim*(dim+1) DIV 2)-1) > HIGH(SV)) THEN
ErrOut('Dimension der Matrix zu gro\3 (SVein)');
MeldFehl;
ELSE
FOR ij:=1 TO (dim*(dim+1) DIV 2) DO SV[ij-1]:=0.0; END;
REPEAT (* Lese von Null verschiedene SVelemente *)
INC(SZeil);
RdCard(Ein,i); IF (i = MAX(CARDINAL)) THEN MeldFehl; END;
RdCard(Ein,j); IF (j = MAX(CARDINAL)) THEN MeldFehl; END;
RdLngReal(Ein,sv); IF (sv = MAX(LONGREAL)) THEN MeldFehl; END;
RdCard(Ein,ind); IF (ind = MAX(CARDINAL)) THEN MeldFehl; END;
IF (i < j ) THEN int:=i; i:=j; j:=int; END;
ij:=(i*(i-1) DIV 2 ) + j;
SV[ij-1]:=sv;
IF Protokoll THEN
TIO.WrCard(i,4); TIO.WrCard(j,4);
TIO.WrLngReal(SV[ij-1],18,9); TIO.WrCard(ind,3); TIO.WrLn;
END;
UNTIL (ind = 0);
INC(SZeil);
RdCard(Ein,halt); IF (halt = MAX(CARDINAL)) THEN MeldFehl; END;
END; (* ELSE *)
END SVein;
PROCEDURE CSVein(VAR Ein : File;
VAR CSV : ARRAY OF LONGCOMPLEX; (* Einzules. Supervektor *)
VAR Name : ARRAY OF CHAR;
VAR dim : CARDINAL; (* dim : Dimension der MATRIX *)
VAR halt : CARDINAL);
PROCEDURE MeldFehl; BEGIN EinFehl(Ein,CSZeil,'CSVein'); END MeldFehl;
VAR csv : RECORD re,im : LONGREAL; END;
ind,int,i,j,ij : CARDINAL;
BEGIN
RdStr(Ein,Name); INC(CSZeil);
RdCard(Ein,dim); INC(CSZeil);
IF (((dim*(dim+1) DIV 2)-1) > HIGH(CSV)) THEN
ErrOut('Dimension der Matrix zu gro\3 (CSVein)');
MeldFehl; (* HALT !!!! *)
ELSE
FOR ij:=1 TO (dim*(dim+1) DIV 2) DO CSV[ij-1]:=CMPLX(0.0,0.0); END;
REPEAT (* Lese von Null verschiedene SVelemente *)
INC(CSZeil);
RdCard(Ein,i); IF (i = MAX(CARDINAL)) THEN MeldFehl; END;
RdCard(Ein,j); IF (j = MAX(CARDINAL)) THEN MeldFehl; END;
RdLngReal(Ein,csv.re);
IF (csv.re = MAX(LONGREAL)) THEN MeldFehl; END;
RdLngReal(Ein,csv.im);
IF (csv.im = MAX(LONGREAL)) THEN MeldFehl; END;
RdCard(Ein,ind); IF (ind = MAX(CARDINAL)) THEN MeldFehl; END;
IF (i < j ) THEN int:=i; i:=j; j:=int; END;
ij:=(i*(i-1) DIV 2 ) + j;
CSV[ij-1]:=CMPLX(csv.re,csv.im);
UNTIL (ind = 0);
INC(CSZeil);
RdCard(Ein,halt); IF (halt = MAX(CARDINAL)) THEN MeldFehl; END;
END; (* ELSE *)
END CSVein;
PROCEDURE WrMatAus(VAR Aus : File;
VAR A : ARRAY OF ARRAY OF LONGREAL;
Name : ARRAY OF CHAR;
M,N : CARDINAL;
halt : CARDINAL;
eps : LONGREAL);
VAR i,j : CARDINAL;
Aij : LONGREAL;
BEGIN
WrStr(Aus,Name); WrLn(Aus);
WrCard(Aus,M,3); WrCard(Aus,N,3); WrLn(Aus);
FOR i:=1 TO M DO
FOR j:=1 TO N DO
Aij:=A[i-1,j-1];
IF NOT ((i = M) AND (j = N)) THEN
IF (ABS(Aij) > eps) THEN
WrCard(Aus,i,3); WrCard(Aus,j,3);
WrLngReal(Aus,Aij,20,12); WrStr(Aus," 1");
WrLn(Aus);
END; (* IF *)
END; (* IF *)
END;
END;
WrCard(Aus,M,3); WrCard(Aus,N,3);
WrLngReal(Aus,A[M-1,N-1],20,12); WrStr(Aus," 0");
WrLn(Aus);
WrCard(Aus,halt,1); WrLn(Aus);
END WrMatAus;
PROCEDURE VEKaus(VAR Aus : File;
dim : CARDINAL;
Name : ARRAY OF CHAR;
VAR Vek : ARRAY OF LONGREAL;
Breite : CARDINAL;
FeldBr : CARDINAL;
Form : CARDINAL);
VAR i,j,k,Leer,VekAnz : CARDINAL;
Komma,Exp : INTEGER;
max,Rest,Zeile,Zeilen : CARDINAL;
Min,Max : LONGREAL;
BEGIN
IF (Form = 1) THEN
IF (FeldBr < 9) THEN FeldBr:=9; END;
Komma:=-(VAL(INTEGER,FeldBr) - 8);
ELSE
IF (FeldBr < 4) THEN FeldBr:=4; END;
Komma:=VAL(INTEGER,FeldBr) - 3;
MinMaxVek(Min,Max,Vek,dim,1);
IF (ABS(Max) >= 10.0) THEN
Exp:=VAL(INTEGER,log10(ABS(Max)));
DEC(Komma,Exp);
IF (Komma < 1) THEN Komma:=1; FeldBr:=Exp+4; END;
END;
END;
i:=0; WHILE (Name[i] <> 0C) AND (i < HIGH(Name)) DO INC(i); END;
VekAnz:=Breite DIV (FeldBr + i + 10);
Zeilen:=dim DIV VekAnz;
Rest :=dim MOD VekAnz;
IF (Rest = 0) THEN Rest:=VekAnz; ELSE INC(Zeilen) END;
WrLnN(Aus,2);
i:=0; Zeile:=1;
REPEAT
IF (Zeile < Zeilen) THEN max:=VekAnz ELSE max:=Rest END;
FOR j:=1 TO max DO
INC(i);
WrStr(Aus,' '); WrStr(Aus,Name); WrChar(Aus,'[');
WrCard(Aus,i,1); WrChar(Aus,']');
IF (i < 10) THEN Leer:=2;
ELSIF (i >= 100) THEN Leer:=0;
ELSE Leer:=1; END;
FOR k:=1 TO Leer DO WrChar(Aus,' '); END;
WrStr(Aus,' : ');
WrLngReal(Aus,Vek[i-1],FeldBr,Komma);
END;
INC(Zeile);
WrLn(Aus);
UNTIL (i >= dim);
WrLn(Aus);
END VEKaus;
PROCEDURE CVEKaus(VAR Aus : File;
dim : CARDINAL;
Name : ARRAY OF CHAR;
VAR Vek : ARRAY OF LONGCOMPLEX;
Breite : CARDINAL;
FeldBr : CARDINAL;
Form : CARDINAL);
VAR i,j,k,Leer,VekAnz : CARDINAL;
Komma,Exp : INTEGER;
max,Rest,Zeile,Zeilen : CARDINAL;
Max : LONGREAL;
BEGIN
IF (Form = 1) THEN
IF (FeldBr < 9) THEN FeldBr:=9; END;
Komma:=-(VAL(INTEGER,FeldBr) - 8);
ELSE
IF (FeldBr < 4) THEN FeldBr:=4; END;
Komma:=VAL(INTEGER,FeldBr) - 3;
Max:=0.0;
FOR i:=0 TO dim-1 DO
IF (ABS(RE(Vek[i])) > Max) THEN Max:=ABS(RE(Vek[i])); END;
IF (ABS(IM(Vek[i])) > Max) THEN Max:=ABS(IM(Vek[i])); END;
END;
IF (ABS(Max) >= 10.0) THEN
Exp:=VAL(INTEGER,log10(ABS(Max)));
DEC(Komma,Exp);
IF (Komma < 1) THEN Komma:=1; FeldBr:=Exp+4; END;
END;
END;
i:=0; WHILE (Name[i] <> 0C) AND (i < HIGH(Name)) DO INC(i); END;
VekAnz:=Breite DIV (2*FeldBr + i + 14);
IF (VekAnz < 1) THEN
ErrOut("Bitte das Argument Breite ueberpruefen (FMatEA.CVEKaus)");
VekAnz:=1;
END;
Zeilen:=dim DIV VekAnz;
Rest :=dim MOD VekAnz;
IF (Rest = 0) THEN Rest:=VekAnz; ELSE INC(Zeilen) END;
WrLnN(Aus,2);
i:=0; Zeile:=1;
REPEAT
IF (Zeile < Zeilen) THEN max:=VekAnz ELSE max:=Rest END;
FOR j:=1 TO max DO
INC(i);
WrStr(Aus,' '); WrStr(Aus,Name); WrChar(Aus,'[');
WrCard(Aus,i,1); WrChar(Aus,']');
IF (i < 10) THEN Leer:=2;
ELSIF (i >= 100) THEN Leer:=0;
ELSE Leer:=1; END;
FOR k:=1 TO Leer DO WrChar(Aus,' '); END;
WrStr(Aus,' : ');
WrLngCmplx(Aus,Vek[i-1],FeldBr,Komma);
END;
INC(Zeile);
WrLn(Aus);
UNTIL (i >= dim);
WrLn(Aus);
END CVEKaus;
PROCEDURE Formate( dim,Format : CARDINAL;
VAR GesamtBr,FeldBr : CARDINAL;
VAR Komma : INTEGER;
VAR leer : CARDINAL;
VAR maxVek : CARDINAL;
Max : LONGREAL;
testdim : BOOLEAN);
(*-------------------------------------------------------------*)
(* Die Routine testet die Formatanweisungen der Matrixausgabe- *)
(* routinen MATaus,SVaus,CMataus,CSVaus,MatVekAus,CMatVekAus *)
(* und korrigiert diese bei Fehleingaben. *)
(*-------------------------------------------------------------*)
VAR Exp : CARDINAL;
BEGIN
IF (maxVek > dim) AND testdim THEN maxVek:=dim; END;
IF (GesamtBr > 132) THEN GesamtBr:=132; END;
IF (FeldBr > 30) THEN FeldBr:=30; END;
Exp:=0;
IF (Format = 1) THEN
IF (FIO2.ExpAnz = 3) THEN
IF (FeldBr < 9) THEN FeldBr:=9; END;
Komma:=-VAL(INTEGER,FeldBr-8);
ELSIF (FIO2.ExpAnz = 2) THEN
IF (FeldBr < 8) THEN FeldBr:=8; END;
Komma:=-VAL(INTEGER,FeldBr-7);
END;
ELSE
IF (FeldBr < 4) THEN FeldBr:=4; END;
Komma:=FeldBr - 3;
IF (ABS(Max) >= 10.0) THEN
Exp:=VAL(CARDINAL,log10(ABS(Max)));
DEC(Komma,Exp);
IF (Komma < 1) THEN Komma:=1; FeldBr:=Exp+4; END;
END;
END;
IF (GesamtBr < (9+FeldBr)) THEN GesamtBr:=FeldBr + 9; END;
leer:=Exp + 8; IF (Komma = 1) THEN DEC(leer); END;
END Formate;
PROCEDURE Null(VAR NullStr : ARRAY OF CHAR;
FeldBr : CARDINAL;
Komma : INTEGER);
(*----------------------------------------------------------------*)
(* Initialisiert den String "NullStr" als '0.' in der durch *)
(* FeldBr und Komma vorgegebenen Form u. L"ange *)
(*----------------------------------------------------------------*)
VAR i : INTEGER;
BEGIN
FOR i:=0 TO VAL(INTEGER,HIGH(NullStr))-1 DO NullStr[i]:=' '; END;
i := VAL(INTEGER,FeldBr) - Komma - 2;
IF (i >= 0) AND (i < VAL(INTEGER,HIGH(NullStr)-1)) THEN
NullStr[i+1]:='0'; NullStr[i+2]:='.';
END;
IF (HIGH(NullStr) >= FeldBr+1) THEN
NullStr[FeldBr+1]:=0C;
ELSE
NullStr[HIGH(NullStr)]:=0C;
END;
END Null;
PROCEDURE MATaus(VAR Aus : File;
M,N : CARDINAL; (* Dimension der MATRIX *)
VAR Mat : ARRAY OF ARRAY OF LONGREAL;
GesamtBr : CARDINAL; (* Breite des Ausdrucks *)
FeldBr : CARDINAL; (* Feldbreite einer Komponente *)
Format : CARDINAL);
VAR VekAnz,m,k,j,i,leer : CARDINAL;
Komma : INTEGER;
Max,Schwelle : LONGREAL;
NullStr : ARRAY [0..34] OF CHAR;
BEGIN
IF (HIGH(Mat) < M-1) OR (HIGH(Mat[0]) < N-1) THEN
Errors.Fehler:=TRUE;
Errors.Fehlerflag:="*** Dimensionierungsfehler (MatEA.MATaus) ***";
Errors.ErrOut(Errors.Fehlerflag);
WrLn(Aus); WrStr(Aus,Errors.Fehlerflag); WrLnN(Aus,2);
RETURN;
END;
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
Max:=ABS(Mat[0,0]);
IF (Format > 1) THEN
FOR i:=0 TO M-1 DO
FOR j:=0 TO N-1 DO
IF (ABS(Mat[i,j]) > Max) THEN Max:=ABS(Mat[i,j]); END;
END;
END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,FALSE);
VekAnz:=(GesamtBr-8) DIV (FeldBr+1);
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1;
IF (k >= M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4);
FOR j:=1 TO FeldBr-3 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=0 TO N-1 DO
WrCard(Aus,i+1,4); WrStr(Aus,' ');
FOR j:=m-1 TO k-1 DO
IF (Format = 3) AND (ABS(Mat[j,i]) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSIF (Format = 1) THEN
WrLngReal(Aus,Mat[j,i],(FeldBr+1),Komma);
ELSE
WrLngReal(Aus,Mat[j,i],(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= M);
WrLn(Aus);
END MATaus;
PROCEDURE PMATaus(VAR Aus : File;
M : CARDINAL; (* Anzahl der Vektoren *)
N : CARDINAL; (* L"ange der Vektoren *)
VAR Mat : PMATRIX;
GesamtBr : CARDINAL; (* Breite des Ausdrucks *)
FeldBr : CARDINAL; (* Feldbreite einer Komponente *)
Format : CARDINAL);
VAR VekAnz,m,k,j,i,leer : CARDINAL;
Komma : INTEGER;
Max,Schwelle : LONGREAL;
NullStr : ARRAY [0..34] OF CHAR;
BEGIN
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
Max:=ABS(Mat^[1]^[1]);
IF (Format > 1) THEN
FOR i:=1 TO M DO
FOR j:=1 TO N DO
IF (ABS(Mat^[i]^[j]) > Max) THEN Max:=ABS(Mat^[i]^[j]); END;
END;
END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,FALSE);
VekAnz:=(GesamtBr-8) DIV (FeldBr+1);
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1;
IF (k >= M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4); FOR j:=1 TO FeldBr-3 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=1 TO N DO
WrCard(Aus,i,4); WrStr(Aus,' ');
FOR j:=m TO k DO
IF (Format = 3) AND (ABS(Mat^[j]^[i]) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,Mat^[j]^[i],(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= M);
WrLn(Aus);
END PMATaus;
PROCEDURE CMATaus(VAR Aus : File;
M : CARDINAL; (* Anzahl der Vektoren *)
N : CARDINAL; (* Laenge eines Vektors *)
VAR CMat : ARRAY OF ARRAY OF LONGCOMPLEX;
GesamtBr : CARDINAL; (* Breite des Ausdrucks *)
FeldBr : CARDINAL; (* Feldbreite einer Komponente *)
Format : CARDINAL);
VAR VekAnz,m,k,j,i,leer : CARDINAL;
Komma : INTEGER;
Max,Schwelle : LONGREAL;
NullStr : ARRAY [0..34] OF CHAR;
BEGIN
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
Max:=ABS(RE(CMat[0,0]));
IF (Format > 2) THEN (* Bestimme Maximum f"ur Flie\3kommadarstllung. *)
FOR i:=0 TO M-1 DO
FOR j:=0 TO N-1 DO
IF (ABS(RE(CMat[i,j])) > Max) THEN Max:=ABS(RE(CMat[i,j])); END;
IF (ABS(IM(CMat[i,j])) > Max) THEN Max:=ABS(IM(CMat[i,j])); END;
END;
END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,FALSE);
VekAnz:=(GesamtBr-8) DIV (2*(FeldBr+1));
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1;
IF (k >= M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4); FOR j:=1 TO 2*FeldBr-2 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=1 TO N DO
WrCard(Aus,i,4); WrStr(Aus,' ');
FOR j:=m TO k DO
IF (Format = 3) AND (ABS(RE(CMat[j-1,i-1])) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,RE(CMat[j-1,i-1]),(FeldBr+1),Komma);
END;
IF (Format = 3) AND (ABS(IM(CMat[j-1,i-1])) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
(*
IF (IM(CMat[j-1,i-1]) < 0.0) THEN
WrStr(Aus," -i*");
ELSE
WrStr(Aus," +i*");
END;
*)
WrLngReal(Aus,(IM(CMat[j-1,i-1])),(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= M);
WrLn(Aus);
END CMATaus;
PROCEDURE SVaus(VAR Aus : File;
dim : CARDINAL; (* Dimension des SUPERVEKTOR *)
maxVek : CARDINAL;
VAR SV : ARRAY OF LONGREAL; (* SUPERVEKTOR *)
GesamtBr : CARDINAL; (* Breite des Ausdrucks *)
FeldBr : CARDINAL; (* Feldbreite einer Komponente *)
Format : CARDINAL);
VAR VekAnz,m,k,j,i,ii,maxk,leer : CARDINAL;
Komma : INTEGER;
Min,Max,Schwelle : LONGREAL;
NullStr : ARRAY [0..34] OF CHAR;
BEGIN
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
Max:=MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format > 1) THEN MinMaxSv(Min,Max,SV,dim,1); END;
Formate(dim,Format,GesamtBr,FeldBr,Komma,leer,maxVek,Max,TRUE);
VekAnz:=(GesamtBr-8) DIV (FeldBr+1);
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1; IF (k >= maxVek) THEN k:=maxVek; END;
WrLn(Aus); FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4); FOR j:=1 TO FeldBr-3 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
ii:=m*(m-1) DIV 2;
FOR i:=m TO dim DO
maxk:=i; IF (maxk > k) THEN maxk:=k; END;
WrCard(Aus,i,4); WrStr(Aus,' ');
FOR j:=m TO maxk DO
IF (Format = 3) AND (ABS(SV[ii+j-1]) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,SV[ii+j-1],(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
INC(ii,i);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= maxVek);
WrLn(Aus);
END SVaus;
PROCEDURE CSVaus(VAR Aus : File;
dim : CARDINAL; (* Dimension des SUPERVEKTOR *)
maxVek : CARDINAL;
VAR CSV : ARRAY OF LONGCOMPLEX;
GesamtBr : CARDINAL; (* Breite des Ausdrucks *)
FeldBr : CARDINAL; (* Feldbreite einer Komponente *)
Format : CARDINAL);
VAR VekAnz,m,k,j,i,ii,maxk,leer : CARDINAL;
Komma : INTEGER;
Max,Schwelle : LONGREAL;
NullStr : ARRAY [0..34] OF CHAR;
BEGIN
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
Max:=0.0;
IF (Format = 2) THEN
FOR i:=0 TO dim*(dim+1)-1 DIV 2 DO
IF (ABS(RE(CSV[i])) > Max) THEN Max:=ABS(RE(CSV[i])); END;
IF (ABS(IM(CSV[i])) > Max) THEN Max:=ABS(IM(CSV[i])); END;
END;
END;
Formate(dim,Format,GesamtBr,FeldBr,Komma,leer,maxVek,Max,TRUE);
VekAnz:=(GesamtBr-8) DIV (2*(FeldBr+1));
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1; IF (k >= maxVek) THEN k:=maxVek; END;
WrLn(Aus); FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4); FOR j:=1 TO 2*FeldBr-2 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
ii:=m*(m-1) DIV 2;
FOR i:=m TO dim DO
maxk:=i; IF (maxk > k) THEN maxk:=k; END;
WrCard(Aus,i,4); WrStr(Aus,' ');
FOR j:=m TO maxk DO
IF (Format = 3) AND (ABS(RE(CSV[ii+j-1])) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,RE(CSV[ii+j-1]),(FeldBr+1),Komma);
END;
IF (Format = 3) AND (ABS(IM(CSV[ii+j-1])) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,IM(CSV[ii+j-1]),(FeldBr+1),Komma);
END;
END; (* FOR j *)
WrLn(Aus);
INC(ii,i);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= maxVek);
WrLn(Aus);
END CSVaus;
PROCEDURE MatVekAus(VAR Aus : File;
M,N : CARDINAL;
VAR Vek : ARRAY OF LONGREAL;
VAR Mat : ARRAY OF ARRAY OF LONGREAL;
GesamtBr : CARDINAL;
FeldBr : CARDINAL;
Format : CARDINAL);
VAR VekAnz,m,k,j,i,leer,Interim : CARDINAL;
Komma,VKomma : INTEGER;
Max,VMax,Schwelle : LONGREAL;
VExp : BOOLEAN;
NullStr : ARRAY [0..31] OF CHAR;
BEGIN
IF (HIGH(Mat)< M-1) OR (HIGH(Mat[0])< N-1) OR (HIGH(Vek) < M-1) THEN
Errors.Fehlerflag:="*** Dimensionierungsfehler (SMatEA.MATaus) ***";
Errors.ErrOut(Errors.Fehlerflag);
WrLn(Aus); WrStr(Aus,Errors.Fehlerflag); WrLnN(Aus,2);
RETURN;
END;
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
IF (Format = 1) THEN
VExp:=TRUE; Max:=0.0;
ELSE
VMax:=ABS(Vek[0]); Max:=ABS(Mat[0,0]);
FOR i:=0 TO M-1 DO (* Bestimme Maxima von Vek,Mat *)
IF (ABS(Vek[i]) > VMax) THEN VMax:=ABS(Vek[i]); END;
FOR j:=0 TO N-1 DO
IF (ABS(Mat[i,j]) > Max) THEN Max:=ABS(Mat[i,j]); END;
END;
END;
VExp:=(VMax >= 100.0*Max); (* Exponentialdarstellung des Vektors ? *)
IF NOT VExp AND (VMax > Max) THEN Max:=VMax; END;
IF VExp AND (FeldBr < 8) THEN FeldBr:=8; Komma:=FeldBr - 3; END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,FALSE);
VKomma:=Komma;
VekAnz:=(GesamtBr-8) DIV (FeldBr+1);
Interim:=FIO2.ExpAnz; (* Wg. Compilerwarnung aus IF herausgezogen *)
IF VExp AND (Format > 1) THEN
FIO2.ExpAnz:=2; VKomma:=-VAL(INTEGER,FeldBr-7);
END;
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1;
IF (k > M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4);
FOR j:=1 TO FeldBr-3 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=1 TO 6 DO WrChar(Aus,' '); END;
FOR i:=m TO k DO WrLngReal(Aus,Vek[i-1],(FeldBr+1),VKomma); END;
WrLnN(Aus,2);
FOR i:=0 TO N-1 DO
WrCard(Aus,i+1,4); WrChar(Aus,' '); WrChar(Aus,' ');
FOR j:=m-1 TO k-1 DO
IF (Format = 3) AND (ABS(Mat[j,i]) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,Mat[j,i],(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= M);
WrLn(Aus);
IF VExp AND (Format = 2) THEN FIO2.ExpAnz:=Interim; END;
END MatVekAus;
PROCEDURE PMatVekAus(VAR Aus : File;
M,N : CARDINAL;
VAR Vek : ARRAY OF LONGREAL;
VAR Mat : PMATRIX;
GesamtBr : CARDINAL;
FeldBr : CARDINAL;
Format : CARDINAL);
VAR VekAnz,m,k,j,i,leer,Interim : CARDINAL;
Komma,VKomma : INTEGER;
Max,VMax,Schwelle : LONGREAL;
VExp : BOOLEAN;
NullStr : ARRAY [0..32] OF CHAR;
BEGIN
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
IF (Format = 1) THEN
VExp:=TRUE; Max:=0.0;
ELSE
VMax:=ABS(Vek[0]); Max:=ABS(Mat^[1]^[1]);
FOR i:=1 TO M DO (* Bestimme Maxima von CVek,CMat *)
IF (ABS(Vek[i-1]) > VMax) THEN VMax:=ABS(Vek[i-1]); END;
FOR j:=1 TO N DO
IF (ABS(Mat^[i]^[j]) > Max) THEN Max:=ABS(Mat^[i]^[j]); END;
END;
END;
VExp:=(VMax >= 100.0*Max); (* Exponentialdarstellung des Vektors ? *)
IF NOT VExp AND (VMax > Max) THEN Max:=VMax; END;
IF VExp AND (FeldBr < 8) THEN FeldBr:=8; Komma:=FeldBr - 3; END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,FALSE);
VKomma:=Komma;
VekAnz:=(GesamtBr-8) DIV (FeldBr+1);
Interim:=FIO2.ExpAnz; (* Wg. Compilerwarnung aus IF herausgezogen *)
IF VExp AND (Format > 1) THEN
FIO2.ExpAnz:=2; VKomma:=-VAL(INTEGER,FeldBr-7);
END;
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1;
IF (k > M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4);
FOR j:=1 TO FeldBr-3 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=1 TO 6 DO WrChar(Aus,' '); END;
FOR i:=m TO k DO WrLngReal(Aus,Vek[i-1],(FeldBr+1),VKomma); END;
WrLnN(Aus,2);
FOR i:=1 TO N DO
WrCard(Aus,i,4); WrChar(Aus,' '); WrChar(Aus,' ');
FOR j:=m TO k DO
IF (Format = 3) AND (ABS(Mat^[j]^[i]) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,Mat^[j]^[i],(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= M);
WrLn(Aus);
IF VExp AND (Format = 2) THEN FIO2.ExpAnz:=Interim; END;
END PMatVekAus;
PROCEDURE CMatVekAus(VAR Aus : File;
N : CARDINAL;
M : CARDINAL;
VAR CVek : ARRAY OF LONGCOMPLEX;
VAR CMat : ARRAY OF ARRAY OF LONGCOMPLEX;
GesamtBr : CARDINAL;
FeldBr : CARDINAL;
Format : CARDINAL);
VAR VekAnz,m,k,j,i,leer,Interim : CARDINAL;
Komma,VKomma : INTEGER;
Max,VMax,Schwelle : LONGREAL;
VExp : BOOLEAN;
NullStr : ARRAY [0..34] OF CHAR;
BEGIN
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
IF (Format = 1) THEN
VExp:=TRUE; Max:=0.0;
ELSE
VMax:=0.0; Max:=0.0;
FOR i:=0 TO M-1 DO (* Bestimme Maxima von CVek,CMat *)
IF (ABS(RE(CVek[i])) > VMax) THEN VMax:=ABS(RE(CVek[i])); END;
IF (ABS(IM(CVek[i])) > VMax) THEN VMax:=ABS(IM(CVek[i])); END;
FOR j:=0 TO N-1 DO
IF (ABS(RE(CMat[i,j])) > Max) THEN Max:=ABS(RE(CMat[i,j])); END;
IF (ABS(IM(CMat[i,j])) > Max) THEN Max:=ABS(IM(CMat[i,j])); END;
END;
END;
VExp:=(VMax >= 100.0*Max); (* Exponentialdarstellung des Vektors ? *)
IF NOT VExp AND (VMax > Max) THEN Max:=VMax; END;
IF VExp AND (FeldBr < 8) THEN FeldBr:=8; Komma:=FeldBr - 3; END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,TRUE);
VekAnz:=(GesamtBr-8) DIV (2*(FeldBr+1));
VKomma:=Komma;
Interim:=FIO2.ExpAnz; (* Wg. Compilerwarnung aus IF herausgezogen *)
IF VExp AND (Format > 1) THEN
FIO2.ExpAnz:=2; VKomma:=-VAL(INTEGER,FeldBr-7);
END;
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m+VekAnz-1;
IF (k > M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4);
FOR j:=1 TO 2*FeldBr-2 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=1 TO 6 DO WrChar(Aus,' '); END;
FOR i:=m TO k DO
WrLngReal(Aus,RE(CVek[i-1]),(FeldBr+1),VKomma);
WrLngReal(Aus,IM(CVek[i-1]),(FeldBr+1),VKomma);
END;
WrLnN(Aus,2);
FOR i:=1 TO N DO
WrCard(Aus,i,4); WrChar(Aus,' '); WrChar(Aus,' ');
FOR j:=m TO k DO
IF (Format = 3) AND (ABS(RE(CMat[j-1,i-1])) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,RE(CMat[j-1,i-1]),(FeldBr+1),Komma);
END;
IF (Format = 3) AND (ABS(IM(CMat[j-1,i-1])) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,IM(CMat[j-1,i-1]),(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= M);
WrLn(Aus);
IF VExp AND (Format = 2) THEN FIO2.ExpAnz:=Interim; END;
END CMatVekAus;
PROCEDURE MVKaus(VAR Aus : File;
N : CARDINAL;
M : CARDINAL;
VAR Komm : ARRAY OF ARRAY OF CHAR;
VAR Vek : ARRAY OF LONGREAL;
VAR Mat : ARRAY OF ARRAY OF LONGREAL;
GesamtBr : CARDINAL;
FeldBr : CARDINAL;
Format : CARDINAL);
CONST links = TRUE; (* Linksb"undiges Ausgabeformat f"ur Komm *)
VAR VekAnz,m,k,j,i,MaxLen : CARDINAL;
Interim,leer,itmp : CARDINAL;
Komma,VKomma : INTEGER;
Max,VMax,Schwelle : LONGREAL;
VExp : BOOLEAN;
NullStr : ARRAY [0..34] OF CHAR;
LenK : POINTER TO
ARRAY [0..MAX(INTEGER)-1] OF CARDINAL;
BEGIN
ALLOCATE(LenK,N*TSIZE(CARDINAL));
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
LenK^[0]:=Length(Komm[0]); MaxLen:=LenK^[0];
FOR i:=1 TO N-1 DO
LenK^[i]:=Length(Komm[i-1]);
IF (LenK^[i] > MaxLen) THEN MaxLen:=LenK^[i]; END;
END;
IF (Format = 1) THEN
VExp:=TRUE; Max:=0.0;
ELSE
VMax:=ABS(Vek[0]); Max:=ABS(Mat[0,0]);
FOR i:=0 TO M-1 DO (* Bestimme Maxima von CVek,CMat *)
IF (ABS(Vek[i]) > VMax) THEN VMax:=ABS(Vek[i]); END;
FOR j:=0 TO N-1 DO
IF (ABS(Mat[i,j]) > Max) THEN Max:=ABS(Mat[i,j]); END;
END;
END;
VExp:=(VMax >= 100.0*Max); (* Exponentialdarstellung des Vektors ? *)
IF NOT VExp AND (VMax > Max) THEN Max:=VMax; END;
IF VExp AND (FeldBr < 8) THEN FeldBr:=8; Komma:=FeldBr - 3; END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,TRUE);
VKomma:=Komma;
VekAnz:=(GesamtBr-MaxLen-8) DIV (FeldBr+1);
IF (VekAnz = 0) THEN
ErrOut('Zu lange Kommentare (MVKaus).');
MatVekAus(Aus,N,M,Vek,Mat,GesamtBr,FeldBr,Format);
RETURN;
END;
Interim:=FIO2.ExpAnz; (* Wg. Compilerwarnung aus IF herausgezogen *)
IF VExp AND (Format > 1) THEN
FIO2.ExpAnz:=2; VKomma:=-VAL(INTEGER,FeldBr-7);
END;
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m + VekAnz - 1;
IF (k > M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer + MaxLen + 2 DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4);
FOR j:=1 TO FeldBr-3 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=1 TO (8 + MaxLen) DO WrChar(Aus,' '); END;
FOR i:=m TO k DO WrLngReal(Aus,Vek[i-1],(FeldBr+1),VKomma); END;
WrLnN(Aus,2);
FOR i:=1 TO N DO
WrCard(Aus,i,4); WrChar(Aus,' '); WrChar(Aus,' ');
IF links THEN WrStr(Aus,Komm[i-1]); END;
(*
FOR j:=1 TO (MaxLen - LenK^[i-1]) DO WrChar(Aus,' '); END;
* [*** 0.00 F450]
* compilation aborted: ASSERT(FALSE,55656) at line 856 of reg386.ob2
*)
itmp:=Length(Komm[i-1]);
FOR j:=1 TO (MaxLen - itmp) DO WrChar(Aus,' '); END;
IF NOT links THEN WrStr(Aus,Komm[i-1]); END;
WrChar(Aus,' '); WrChar(Aus,' ');
FOR j:=m TO k DO
IF (Format = 3) AND (ABS(Mat[j-1,i-1]) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,Mat[j-1,i-1],(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
INC(m,VekAnz);
UNTIL (k >= M);
WrLn(Aus);
IF VExp AND (Format = 2) THEN FIO2.ExpAnz:=Interim; END;
DEALLOCATE(LenK,N*TSIZE(CARDINAL));
END MVKaus;
PROCEDURE SVKaus(VAR Aus : File;
M,N : CARDINAL;
VAR SV : ARRAY OF LONGREAL; (* SUPERVEKTOR *)
VAR Komm : ARRAY OF ARRAY OF CHAR;
GesamtBr : CARDINAL;
FeldBr : CARDINAL;
Format : CARDINAL;
quad : BOOLEAN);
CONST MaxINT = MAX(INTEGER);
StrLen = 32;
VAR m,k,i,j,ij,ii,maxk : CARDINAL;
VekAnz,leer,MaxLen : CARDINAL;
Komma : INTEGER;
Max,Schwelle,SVij : LONGREAL;
Len : POINTER TO
ARRAY [0..MaxINT-1] OF CARDINAL;
KommH : POINTER TO ARRAY [0..MaxINT-1] OF
POINTER TO ARRAY [0..StrLen-1] OF CHAR;
NullStr : ARRAY [0..StrLen-1] OF CHAR;
BEGIN
ALLOCATE(Len,N*TSIZE(CARDINAL));
ALLOCATE(KommH,N*TSIZE(ADDRESS));
FOR i:=0 TO N-1 DO
ALLOCATE(KommH^[i],StrLen*TSIZE(CHAR));
END;
Fehler:=FALSE;
IF (NOT (Format IN {1,2,3})) THEN Format:=1; END;
Len^[0]:=Length(Komm[0]); MaxLen:=Len^[0];
FOR i:=1 TO N-1 DO
Len^[i]:=Length(Komm[i-1]);
IF (Len^[i] > MaxLen) THEN MaxLen:=Len^[i]; END;
END;
IF (Format = 1) THEN
Max:=0.0;
ELSE
Max:=ABS(SV[1]); ij:=0;
FOR i:=1 TO N DO (* Bestimme Maxima von SV *)
FOR j:=1 TO i DO
IF (ABS(SV[ij]) > Max) THEN Max:=ABS(SV[ij]); END;
INC(ij);
END;
END;
END;
Formate(N,Format,GesamtBr,FeldBr,Komma,leer,M,Max,FALSE);
FOR i:=0 TO N-1 DO
Assign(Komm[i],KommH^[i]^);
RmMultBlnk(KommH^[i]^); (* Get rid of multiple blanks *)
END;
IF (MaxLen > FeldBr) THEN (* Schneide die Kommentare ab *)
FOR i:=0 TO N-1 DO
KommH^[i]^[FeldBr-1]:="~";
KommH^[i]^[FeldBr ]:=0C;
END;
END;
(* Die 8 da fuer Index-Feld 4 Zeichen und je 2 Leerzeichen *)
(* vor dem Index und hinter dem Kommentar ausgegeben werden *)
IF (GesamtBr < MaxLen+8) THEN
ErrOut('Breite der Ausgabe falsch gewaehlt (SVKaus)');
SVaus(Aus,N,N,SV,GesamtBr,FeldBr,Format);
RETURN;
END;
VekAnz:=(GesamtBr-MaxLen-8) DIV (FeldBr+1);
IF (VekAnz = 0) THEN
ErrOut('Zu lange Kommentare (SVKaus)');
SVaus(Aus,N,N,SV,GesamtBr,FeldBr,Format);
RETURN;
END;
IF (Format > 1) AND (Max < 1.0E+100) THEN
FIO2.ExpAnz:=2;
END;
Schwelle := MAX(LONGREAL); (* Wg. Compilerwarnung *)
IF (Format = 3) THEN
Null(NullStr,FeldBr,Komma);
Schwelle := 0.5 / CardPot(10.0,VAL(CARDINAL,Komma));
END;
m:=1;
REPEAT
k:=m + VekAnz - 1; IF (k > M) THEN k:=M; END;
WrLn(Aus);
FOR i:=1 TO leer + MaxLen + 2 DO WrChar(Aus,' '); END;
FOR i:=m TO k-1 DO
WrCard(Aus,i,4);
FOR j:=1 TO FeldBr-3 DO WrChar(Aus,' '); END;
END;
WrCard(Aus,k,4); WrLnN(Aus,2);
FOR i:=1 TO leer + MaxLen + 1 DO WrChar(Aus,' '); END;
FOR i:=m TO k DO
WrChar(Aus,' ');
IF (i < k) THEN
WrStrForm(Aus,KommH^[i-1]^,-VAL(INTEGER,FeldBr));
ELSE
WrStr(Aus,KommH^[i-1]^);
END;
END;
WrLnN(Aus,2);
IF quad THEN
FOR i:=1 TO N DO
WrCard(Aus,i,4); WrCharN(Aus,' ',2);
WrStrForm(Aus,Komm[i-1],-VAL(INTEGER,MaxLen));
WrCharN(Aus,' ',2);
FOR j:=m TO k DO
SVij := SV[IJtab(i,j)-1];
IF (Format = 3) AND (ABS(SVij) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,SVij,(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
END; (* FOR i *)
ELSE
ii:=m*(m-1) DIV 2;
FOR i:=m TO N DO
WrCard(Aus,i,4); WrCharN(Aus,' ',2);
WrStrForm(Aus,Komm[i-1],-VAL(INTEGER,MaxLen));
WrCharN(Aus,' ',2);
maxk:=i; IF (maxk > k) THEN maxk:=k; END;
FOR j:=m TO maxk DO
IF (Format = 3) AND (ABS(SV[ii+j-1]) < Schwelle) THEN
WrStr(Aus,NullStr);
ELSE
WrLngReal(Aus,SV[ii+j-1],(FeldBr+1),Komma);
END;
END;
WrLn(Aus);
INC(ii,i);
END; (* FOR i *)
END;
INC(m,VekAnz);
IF (k < N) THEN WrLn(Aus); END;
UNTIL (k >= M);
WrLn(Aus);
FOR i:=0 TO N-1 DO
DEALLOCATE(KommH^[i],StrLen*TSIZE(CHAR));
END;
DEALLOCATE(KommH,N*TSIZE(ADDRESS));
DEALLOCATE(Len,N*TSIZE(CARDINAL));
END SVKaus;
PROCEDURE WrMatConst( Aus : File;
M,N : CARDINAL;
VAR A : ARRAY OF ARRAY OF LONGREAL);
VAR i,j : CARDINAL;
BEGIN
WrStr(Aus,"TYPE Mat");
WrCard(Aus,M,1); WrCard(Aus,N,1);
WrStr(Aus," = ARRAY [1.."); WrCard(Aus,M,1);
WrStr(Aus,"] OF ARRAY [1.."); WrCard(Aus,N,1);
WrStr(Aus,"] OF REAL;"); WrLnN(Aus,2);
WrStr(Aus,"CONST "); WrStr(Aus,"MatMN = Mat");
WrCard(Aus,M,1); WrCard(Aus,N,1);
WrChar(Aus,"{"); WrLn(Aus);
FOR i:=0 TO M-1 DO
WrCharN(Aus," ",21); WrChar(Aus,"{");
FOR j:=0 TO N-2 DO
WrLngReal(Aus,A[i,j],9,3); WrStr(Aus,", ");
END;
WrLngReal(Aus,A[i,N-1],9,3); WrChar(Aus,"}");
IF (i # M-1) THEN WrChar(Aus,","); END;
WrLn(Aus);
END;
WrCharN(Aus," ",19); WrStr(Aus,"};"); WrLn(Aus);
END WrMatConst;
BEGIN
MZeil:=0; CMZeil:=0;
SZeil:=0; CSZeil:=0;
END FMatEA.