program kursovaya;
Uses  crt;
Label 1,2,3,4,5;
Const amax=25; bmax=25;
Type massiv = array [1..amax, 1..bmax] of real;
Var
   z: char;
   s, l12, l13, l14, l21, l23, l24, l31, l32, l34, l41, l42, l43: real;
   q, x, a, a1, b, b1, a2, b2, a3, b3, a4, b4, i, j, k: integer;
   m1, m2, m3, m4, c, c12, c13, c14, c21, c23, c24, c31, c32,
   c34, c41, c42, c43: massiv;
   l: array [1..12] of real;
  Procedure input_array (a,b: integer; var mas: massiv);
   var i,j: integer;
   begin
    for i:=1 to a do
     for j:=1 to b do
      begin
       randomize;
        for i:=1 to a do
         for j:=1 to b do
       mas[i,j]:=random(5);
      end;
   end; {input_array}

  Procedure out_array (a, b:integer; var mas: massiv);
   var i, j: integer;
    begin
     write('Matrix ',a,' ','X',b);
     for i:=1 to a do
      begin
       writeln;
       for j:=1 to b do
        write(mas[i,j]:4:0,' ');
      end;
      writeln;
    end;  {out_array}

  Procedure mass_mult (a, b:integer; var x, y, mas: massiv);
     var i, j, k: integer;
         s: real;
      begin
          for i:=1 to a do
           for j:=1 to b do
        begin
           s:=0;
           for k:=1 to a do
           s:=s+x[i,k]*y[k,j];
           mas[i,j]:=s;
        end;
      end; {mass_mult}

  Procedure sled (a, b: integer; var l: real; c: massiv);
     var i, j: integer;
     begin
       for i:=1 to a do
        for j:=1 to b do
         begin
         l:=0;
         for i:=1 to a do
         l:=l+c[i,i];
         end;
  end; {sled}

  Procedure vozr (a, b: integer; var c:massiv);
    var  i, j: integer;
         k: real;
         sort: boolean;
    begin
      Repeat
         sort := false;
         for i:=1 to b-1 do
         if c[i,i] > c[i+1,i+1] then
         begin
          k:=c[i,i];
          c[i,i]:=c[i+1,i+1];
          c[i+1,i+1]:=k;
          sort:= true;
         end;
      Until sort = false;
  end;  {vozr}

  Procedure max_sled (i: integer; var x: real);
    var k: integer; max: real;
     begin
      max:=l[i];
       for i:=1 to 12 do
        begin
         if max<l[i] then max:=l[i];
        end;

       for i:=1 to 12 do
        begin
         if l[i]=max then
         begin
         x:=i;
         writeln('Index of the maximum element ',x:4:2);

      if X=1 then
      begin
      vozr (a1, b2, c12);
      writeln ('Matrix c12');
      out_array (a1, b2, c12);
      end;

      if X=2 then
      begin
      vozr (a1, b3, c13);
      writeln ('Matrix c13');
      out_array (a1, b3, c13);
      end;

      if X=3 then
      begin
      vozr (a1, b4, c14);
      writeln ('Matrix c14');
      out_array (a1, b4, c14);
      end;

      if X=4 then
      begin
      vozr (a2, b1, c21);
      writeln ('Matrix c21');
      out_array (a2, b1, c21);
      end;

      if X=5 then
      begin
       vozr (a2, b3, c23);
       writeln ('Matrix c23');
       out_array (a2, b3, c23);
      end;

      if X=6 then
      begin
       vozr (a2, b4, c24);
       writeln ('Matrix c24');
       out_array (a2, b4, c24);
      end;

      if X=7 then
      begin
       vozr (a3, b1, c31);
       writeln ('Matrix c31');
       out_array (a3, b1, c31);
      end;

      if X=8 then
      begin
       vozr (a3, b2, c32);
       writeln ('Matrix c32');
       out_array (a3, b2, c32);
      end;

      if X=9 then
      begin
       vozr (a3, b4, c34);
       writeln ('Matrix c34');
       out_array (a3, b4, c34);
      end;

      if X=10 then
      begin
       vozr (a4, b1, c41);
       writeln ('Matrix c41');
       out_array (a4, b1, c41);
      end;

      if X=11 then
      begin
       vozr (a4, b2, c42);
       writeln ('Matrix c42');
       out_array (a4, b2, c42);
      end;

      if X=12 then
      begin
       vozr (a4, b3, c43);
       writeln ('Matrix c43');
       out_array (a4, b3, c43);
      end;
      readln;
         end;
        end;
  end; {max_sled}

  function f_read: word;
  var i, j: word; f_p: text; s: string;
  begin
    assign (f_p,'_!!!_.txt');
    reset (f_p);
    while not eof (f_p) do
    begin
      clrscr;
      readln (f_p, s);
      writeln (s);
    end;
    close(f_p);
    f_read:=0;
  end; {f_read}

  function f_save: word;
  var i, j: word; f_p: text;
  begin
    assign (f_p,'_!!!_.txt');
    rewrite (f_p);
   for i:=1 to a1 do
    begin
     for j:=1 to b1 do
     write (f_p,m1[i,j]:4:0);
     writeln;
    end;
     writeln;
   for i:=1 to a2 do
    begin
     for j:=1 to b2 do
     write (f_p,m2[i,j]:4:0);
     writeln;
    end;
     writeln;
   for i:=1 to a3 do
    begin
     for j:=1 to b3 do
     write (f_p,m3[i,j]:4:0);
     writeln;
    end;
     writeln;
   for i:=1 to a4 do
    begin
     for j:=1 to b4 do
     write (f_p,m4[i,j]:4:0);
     writeln;
    end;
     writeln;
    close (f_p);
    f_save:=0;
  end; {f_save}

  Procedure beep;
  begin
   sound(500);delay(100);nosound;
  end; {beep}

  Procedure beep1;
  begin
   sound(3000);delay(100);nosound;
  end; {beep1}

Begin
1:   clrscr;
     gotoxy(30,10);
     write('Introduction');
     gotoxy(30,11);
     write('Input matrix');
     gotoxy(30,12);
     write('Output matrix');
     gotoxy(30,13);
     write('Multiply matrix');
     gotoxy(30,14);
     write('Save in file');
     gotoxy(30,15);
     write('Load from file');
     gotoxy(30,16);
     write('Exit');
     gotoxy(26,10);
     write('>>>');
     gotoxy(25,10);
     repeat z:=readkey;
           if z=chr(80) then  begin
                                   q:=whereY;
                                   gotoxy(26,q);
                                   write('   ');
                                   if q>=16 then q:=9;
                                   gotoxy(26,q+1);
                                   write('>>>');
                                   gotoxy(25,q+1);
                                   sound(200);
                                   delay(60);
                                   nosound;
                              end;
           if z=chr(72) then  begin
                                   q:=whereY;
                                   gotoxy(26,q);
                                   write('   ');
                                   if q<=10 then q:=17;
                                   gotoxy(26,q-1);
                                   write('>>>');
                                   gotoxy(25,q-1);
                                   sound(400);
                                   delay(60);
                                   nosound;
                              end;
           if z=chr(13) then  begin
                                   q:=whereY;
                   if q=10 then begin
                                   beep1;
                                   clrscr;
                                   gotoxy(15,q);
                                   write('Osnovnoy cely dannoy kursovoy raboti yavliaetsa');
                                   gotoxy(15,q+1);
                                   write('zakreplenie i demonstraciya znaniy, poluchennih');
                                   gotoxy(15,q+2);
                                   write('za vremia izucheniya kursa <Programmirovanie na');
                                   gotoxy(15,q+3);
                                   write('yazikah visokogo urovna>.');
                                readln;
                                goto 1;
                                end;
                   if q=11 then begin
                                   beep1;
                                   goto 2;
                                end;
                   if q=12 then begin
                                   beep1;
                                   goto 4;
                                 end;
                   if q=13 then begin
                                   beep1;
                                   goto 3;
                                end;
                   if q=14 then begin
                                   beep1;
                                   f_save;
                                   goto 1;
                                end;
                   if q=15 then begin
                                   beep1;
                                   goto 5;
                                end;
                   if q=16 then begin
                                   sound(1000);
                                   delay(100);
                                   nosound;
                                   clrscr;
                                   gotoxy(38,12);
                                   write('Exit');
                                   readln;
                                   exit;
                                end;
                              end;
     until z = chr(27);

2:  Clrscr;
    Writeln('Vvedite matricu 1');
    Repeat
     Write('Vvedite kolichestvo strok matrici m1 <= '  ,amax:2);
     write(', i = ');
     readln(a1);
     Write('Vvedite kolichestvo stolbcov matrici m1 <= ',bmax:2);
     write(', j = ');
     readln(b1);
    Until (a1<=amax) and (b1<=bmax);
     input_array (a1,b1,m1);
     out_array (a1,b1,m1);
     readln;
     Writeln('Vvedite matricu 2');
     beep;
    Repeat
     Write('Vvedite kolichestvo strok matrici m2 <= '  ,amax:2);
     write(', i = ');
     readln(a2);
     Write('Vvedite kolichestvo stolbcov matrici m2 <= ',bmax:2);
     write(', j = ');
     readln(b2);
    Until (a2<=amax) and (b2<=bmax);
     input_array (a2,b2,m2);
     out_array (a2,b2,m2);
     readln;
     Writeln('Vvedite matricu 3');
     beep;
    Repeat
     Write('Vvedite kolichestvo strok matrici m3 <= '  ,amax:2);
     write(', i = ');
     readln(a3);
     Write('Vvedite kolichestvo stolbcov matrici m3 <= ',bmax:2);
     write(', j = ');
     readln(b3);
    Until (a3<=amax) and (b3<=bmax);
     input_array (a3,b3,m3);
     out_array (a3,b3,m3);
     readln;
     Writeln('Vvedite matricu 4');
     beep;
    Repeat
     Write('Vvedite kolichestvo strok matrici m4 <= '  ,amax:2);
     write(', i = ');
     readln(a4);
     Write('Vvedite kolichestvo stolbcov matrici m4 <= ',bmax:2);
     write(', j = ');
     readln(b4);
    Until (a4<=amax) and (b4<=bmax);
     input_array (a4,b4,m4);
     out_array (a4,b4,m4);
     writeln ('Vse i,j ');
     writeln (a1, b1, a2, b2, a3, b3, a4, b4);
     readln;
     goto 1;

3:    clrscr;
      if b1=a2 then
         begin
           writeln('Multiples m1 X m2');
           mass_mult(a1, b2 ,m1, m2, c12);
           out_array(a1, b2, c12);
           sled (a1, b2, l12, c12);
           l[1]:=l12;
           writeln('Sled matrici =', l12:4:0);
           vozr(a1, b2, c12);
           out_array (a1, b2, c12);
         end
      else writeln('Matrixes m1 and m2 do not multiples');
      readln;
      if b1=a3 then
         begin
           writeln('Multiples m1 X m3');
           mass_mult(a1, b3, m1, m3, c13);
           out_array(a1, b3, c13);
           sled (a1, b3, l13, c13);
           l[2]:=l13;
           writeln('Sled matrici =', l13:4:0);
           vozr(a1, b3, c13);
           out_array (a1, b3, c13);
         end
      else writeln('Matrixes m1 and m3 do not multiples');
      readln;
      if b1=a4 then
         begin
           writeln('Multiples m1 X m4');
           mass_mult(a1, b4, m1, m4, c14);
           out_array(a1, b4, c14);
           sled (a1, b4, l14, c14);
           l[3]:=l14;
           writeln('Sled matrici =', l14:4:0);
           vozr(a1, b4, c14);
           out_array (a1, b4, c14);
         end
      else writeln('Matrixes m1 and m4 do not multiples');
      writeln('-----------------------');
      readln;

      if b2=a1 then
         begin
           writeln('Multiples m2 X m1');
           mass_mult(a2, b1, m2, m1, c21);
           out_array(a2, b1, c21);
           sled (a2, b1, l21, c21);
           l[4]:=l21;
           writeln('Sled matrici =', l21:4:0);
           vozr(a2, b1, c21);
           out_array (a2, b1, c21);
         end
      else writeln('Matrixes m2 and m1 do not multiples');
      readln;
      if b2=a3 then
         begin
           writeln('Multiples m2 X m3');
           mass_mult(a2, b3, m2, m3, c23);
           out_array(a2, b3, c23);
           sled (a2, b3, l23, c23);
           l[5]:=l23;
           writeln('Sled matrici =', l23:4:0);
           vozr(a2, b3, c23);
           out_array (a2, b3, c23);
         end
      else writeln('Matrixes m2 and m3 do not multiples');
      readln;
      if b2=a4 then
         begin
           writeln('Multiples m2 X m4');
           mass_mult(a2, b4, m2, m4, c24);
           out_array(a2, b4, c24);
           sled (a2, b4, l24, c24);
           l[6]:=l24;
           writeln('Sled matrici =', l24:4:0);
           vozr(a2, b4, c24);
           out_array (a2, b4, c24);
         end
      else writeln('Matrixes m2 and m4 do not multiples');
      writeln('-----------------------');
      readln;

      if b3=a1 then
         begin
           writeln('Multiples m3 X m1');
           mass_mult(a3, b1, m3, m1, c31);
           out_array(a3, b1, c31);
           sled (a3, b1, l31, c31);
           l[7]:=l31;
           writeln('Sled matrici =', l31:4:0);
           vozr(a3, b1, c31);
           out_array (a3, b1, c31);
         end
      else writeln('Matrixes m3 and m1 do not multiples');
      readln;
      if b3=a2 then
         begin
           writeln('Multiples m3 X m2');
           mass_mult(a3, b2, m3, m2, c32);
           out_array(a3, b2, c32);
           sled (a3, b2, l32, c32);
           l[8]:=l32;
           writeln('Sled matrici =', l32:4:0);
           vozr(a3, b2, c32);
           out_array (a3, b2, c32);
         end
      else writeln('Matrixes m3 and m2 do not multiples');
      readln;
      if b3=a4 then
         begin
           writeln('Multiples m3 X m4');
           mass_mult(a3, b4, m3, m4, c34);
           out_array(a3, b4, c34);
           sled (a3, b4, l34, c34);
           l[9]:=l34;
           writeln('Sled matrici =', l34:4:0);
           vozr(a3, b4, c34);
           out_array (a3, b4, c34);
         end
      else writeln('Matrixes m3 and m4 do not multiples');
      writeln('-----------------------');
      readln;

      if b4=a1 then
         begin
           writeln('Multiples m4 X m1');
           mass_mult(a4, b1, m4, m1, c41);
           out_array(a4, b1, c41);
           sled (a4, b1, l41, c41);
           l[10]:=l41;
           writeln('Sled matrici =', l41:4:0);
           vozr(a4, b1, c41);
           out_array (a4, b1, c41);
         end
      else writeln('Matrixes m4 and m1 do not multiples');
      readln;
       if b4=a2 then
         begin
           writeln('Multiples m4 X m2');
           mass_mult(a4, b2, m4, m2, c42);
           out_array(a4, b2, c42);
           sled (a4, b2, l42, c42);
           l[11]:=l42;
           writeln('Sled matrici =', l42:4:0);
           vozr(a4, b2, c42);
           out_array (a4, b2, c42);
         end
      else writeln('Matrixes m4 and m2 do not multiples');
      readln;
       if b4=a3 then
         begin
           writeln('Multiples m4 X m3');
           mass_mult(a4, b3, m4, m3, c43);
           out_array(a4, b3, c43);
           sled (a4, b3, l43, c43);
           l[12]:=l43;
           writeln('Sled matrici =', l43:4:0);
           vozr(a4, b3, c43);
           out_array (a4, b3, c43);
         end
      else writeln('Matrixes m4 and m3 do not multiples');
      writeln('-----------------------');
      readln;

      for i:=1 to 12 do
      write(l[i]:4:0);
      readln;

      max_sled (x,l[i]);
      readln;
      goto 1;

4:     clrscr;
       writeln ('Matrix m1');
       out_array (a1, b1, m1);
       writeln;

       writeln('Matrix m2');
       out_array (a2, b2, m2);
       writeln;

       writeln('Matrix m3');
       out_array (a3, b3, m3);
       writeln;

       writeln('Matrix m4');
       out_array (a4, b4, m4);
       writeln;
       readln;
       goto 1;

5:     f_read;
       readln;
       goto 1;
End.