--- a
+++ b/FMatEA.mod
@@ -0,0 +1,1520 @@
+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) *)
+ (*------------------------------------------------------------------------*)
+ (* 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;
+
+BEGIN
+ MZeil:=0; CMZeil:=0;
+ SZeil:=0; CSZeil:=0;
+END FMatEA.