/***********************************************************************
*                                                                      *
*   GLEICHUNGS-SYSTEME   aufgeloest nach Gauss'schem Algorithmus       *
*                                                                      *
*     V 1.1             ( TH.HARDEGGER 20.5.85) REV 20.2.86            *
*                                                                      *
* { ob das PAGE-Format PEARL-konform angewandt ist, wird bezweifelt }  *
***********************************************************************/
        
S=F00;

MODULE MGLSY;

 SYSTEM;
       CMD:A1;

 PROBLEM;
       SPC CMD DATION INOUT ALPHIC CONTROL(ALL);
       DCL  (I,K,DIM) FIXED,
            (BUFFER,FAKTOR) FLOAT,
            INVEX BIT,               /* Loesung moeglich    */
            KOEFFMAT(10,21) FLOAT,   /* Koeffizientenmatrix */
            TITEL(10) CHAR;          /* Variablenindizes    */


GLSY: TASK;

TITEL(1):='x';TITEL(2):='y';TITEL(3):='z';TITEL(4):='u';TITEL(5):='v';
TITEL(6):='w';TITEL(7):='p';TITEL(8):='q';TITEL(9):='r';TITEL(10):='s';

/*-------------------------------------------------------------------*/
/*                      EINGABE                                      */
/*-------------------------------------------------------------------*/

   PUT '*** PROGRAMM GLEICHUNG-SYSTEME ***',' Anzahl Unbekannte := '
      TO CMD BY SKIP(2),A,SKIP(2),A;
   GET DIM FROM CMD
      BY SKIP,F(3);
   IF DIM > 10 THEN              /* Dimensionsgrenze ueberschritten ? */
     PUT ' DIMmax = 10 !! ' TO CMD BY SKIP,A;
     TERMINATE;
   FIN;

/*-------------- EINGABE DER KOEFFIZIENTEN --------------------------*/

   PUT ' Eingabe der Koeffizientenmatrix :' TO CMD
      BY SKIP(2),A,SKIP(2),X(8);
   FOR UNBEK TO DIM REPEAT           /* Ueberschrift mit Unbekannten */
     IF UNBEK==7 THEN PUT TO CMD BY SKIP,X(8); FIN;
     PUT TITEL(UNBEK) TO CMD BY X(7),A;
   END;
   PUT TO CMD BY SKIP;
   FOR ZEILE TO DIM REPEAT                  /* Tabellarische Eingabe */
       PUT '  ',ZEILE,'. ZEILE : ' TO CMD  /* der Koeffizientenmatrix */
          BY SKIP,A,F(2),A,X;              /*  mit Zeilennummern      */
       K:=0; I:=1;
       FOR SPALTE TO DIM REPEAT
           IF SPALTE==7 THEN PUT TO CMD BY SKIP; I:=7; FIN;
           PUT TO CMD
              BY PAGE((SPALTE-I) * 8 + K);       /* Tabellenvorschub */
           GET KOEFFMAT(ZEILE,SPALTE) FROM CMD
              BY F(8);
           K:=15;                                /* Tabellenkorrektur */
       END;
       IF I/=7 THEN                                 /* Eingabe des */
         PUT '=' TO CMD BY PAGE(DIM*8+K),A,X(2);    /* Stoervektors */
       ELSE
         PUT '=' TO CMD BY PAGE(63),A,X(2);
       FIN;
       GET KOEFFMAT(ZEILE,2*DIM+1) FROM CMD  /* Stoervektor */
          BY F(8);
       PUT TO CMD BY SKIP;
   END;

/*-------------------------------------------------------------------*/
/*                 ERSTELLEN DER IDENTITAET                          */
/*-------------------------------------------------------------------*/

   FOR ZEILE TO DIM REPEAT                    /* 1 0 0 0 */
       FOR SPALTE FROM 1+DIM TO 2*DIM REPEAT  /* 0 1 0 0 */
           KOEFFMAT(ZEILE,SPALTE):=0;         /* 0 0 1 0 */
       END;                                   /* 0 0 0 1 */
       KOEFFMAT(ZEILE,ZEILE + DIM):=1;
   END;

/*-------------------------------------------------------------------*/
/*         GAUSS'SCHER ALGORITHMUS                                   */
/*-------------------------------------------------------------------*/

   INVEX:='1'B;
   I:=0;
   WHILE INVEX AND I < DIM REPEAT   /* Inverse Matrix existent und */
      I:=I+1;K:=I;                  /* Pivot < Matrixdimension     */

/*-------- PIVOTSUCHE -----------------------------------------------*/

      WHILE KOEFFMAT(K,I) == 0  AND K < DIM REPEAT
        K:=K+1;
      END;

/*-------- ZEILENTAUSCH ---------------------------------------------*/

        IF KOEFFMAT(K,I)/=0 AND I/=DIM THEN
           FOR J FROM I TO 2*DIM+1 REPEAT
             BUFFER:= KOEFFMAT(K,J);
             KOEFFMAT(K,J):= KOEFFMAT(I,J);
             KOEFFMAT(I,J):= BUFFER;
           END;
        FIN;

/*-------- PIVOT AUF 1 BRINGEN --------------------------------------*/

      IF KOEFFMAT(I,I) /= 0 THEN                      /* PIVOT /= 0 ? */
        FOR J FROM 2*DIM+1 BY -1 TO I REPEAT          /* JA : weiter  */
          KOEFFMAT(I,J):= KOEFFMAT(I,J)/KOEFFMAT(I,I);
        END;
      ELSE INVEX:='0'B;                  /* NEIN : Loesung unmoeglich */
           PUT ' abhaengiges Gleichungssystem !! ' TO CMD
              BY SKIP(3),A,SKIP;
      FIN;

/*-------- SPALTEN LEEREN -------------------------------------------*/

      FOR ZEILE TO DIM REPEAT              /* alle ausser Pivotzeile */
        IF ZEILE /= I AND KOEFFMAT(I,I) /= 0 THEN
           FAKTOR:= KOEFFMAT(ZEILE,I) / KOEFFMAT(I,I);
           FOR SPALTE FROM I TO 2*DIM+1 REPEAT
             KOEFFMAT(ZEILE,SPALTE):= KOEFFMAT(ZEILE,SPALTE)
                                      - FAKTOR * KOEFFMAT(I,SPALTE);
           END;
        FIN;
      END;

   END;

   IF INVEX THEN
/*--------------------------------------------------------------------*/
/*                 AUSGABE DER LOESUNG                                */
/*--------------------------------------------------------------------*/

      PUT '  LOESUNGEN :' TO CMD BY SKIP,A,SKIP(2);       /* Titel */
      FOR ZEILE TO DIM REPEAT
        IF ZEILE==6 THEN PUT TO CMD BY SKIP(2); FIN;
        PUT TITEL(ZEILE),' = ',KOEFFMAT(ZEILE,2*DIM+1) TO CMD
           BY X(3),A,A,F(8,3);
      END;
  FIN;

  PUT '*** PROGRAMMENDE ***' TO CMD BY SKIP(2),A,SKIP;

  END;      /* TASK-ENDE */
        
MODEND;
/*------------------ PROGRAMMBEENDET ---------------------------------*/