home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / PAS_ENG.ZIP / MATR1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-03  |  1.9 KB  |  107 lines
  1. program matr1;        { -> 50 }
  2. { pascal program to perform matrix multiplication }
  3.  
  4. const    rmax    = 9;
  5.     cmax    = 3;
  6.  
  7.  
  8. type    ary    = array[1..rmax] of real;
  9.     arys    = array[1..cmax] of real;
  10.     ary2    = array[1..rmax,1..cmax] of real;
  11.     ary2s    = array[1..cmax,1..cmax] of real;
  12.  
  13. var    y        : ary;
  14.     g        : arys;
  15.     x        : ary2;
  16.     a        : ary2s;
  17.     nrow,ncol    : integer;
  18.  
  19. external procedure cls;
  20.  
  21. procedure get_data(var x: ary2;
  22.            var y: ary;
  23.        var nrow,ncol: integer);
  24.  
  25. { get the values for nrow, ncol, and arrays x,y }
  26.  
  27. var    i,j    : integer;
  28.  
  29. begin
  30.   nrow:=5;
  31.   ncol:=3;
  32.   for i:=1 to nrow do
  33.     begin
  34.     x[i,1]:=1;
  35.     for j:=2 to ncol do
  36.       x[i,j]:=i*x[i,j-1];
  37.     y[i]:=2*i
  38.     end
  39. end;        { procedure get_data }
  40.  
  41.  
  42.  
  43. procedure write_data;
  44.  
  45. { print out the answeres }
  46.  
  47. var
  48.   i,j    : integer;
  49.  
  50. begin
  51.   cls;
  52.   writeln;
  53.   writeln('          X             Y');
  54.   for i:=1 to nrow do
  55.     begin
  56.     for j:=1 to ncol do
  57.       write(x[i,j]:7:1,' ');
  58.     writeln(':',y[i]:7:1)
  59.     end;
  60.   writeln('          A             G');
  61.   for i:=1 to ncol do
  62.     begin
  63.     for j:=1 to ncol do
  64.       write(a[i,j]:7:1,' ');
  65.     writeln(':',g[i]:7:1)
  66.     end
  67. end;        { write_data }
  68.  
  69.  
  70. procedure square(x: ary2;
  71.          y: ary;
  72.          var a: ary2s;
  73.          var g: arys;
  74.      nrow,ncol: integer);
  75.  
  76. { matrix multiplication routine }
  77. { a= transpose x times x }
  78. { g= y times x }
  79.  
  80. var
  81.  i,k,l    : integer;
  82.  
  83. begin        { square }
  84.   for k:=1 to ncol do
  85.     begin
  86.     for l:=1 to k do
  87.       begin
  88.         a[k,l]:=0;
  89.         for i:=1 to nrow do
  90.         begin
  91.           a[k,l]:=a[k,l]+x[i,l]*x[i,k];
  92.           if k<>l then a[l,k]:=a[k,l]
  93.         end
  94.      end;        { l-loop }
  95.      g[k]:=0;
  96.      for i:=1 to nrow do
  97.      g[k]:=g[k]+y[i]*x[i,k]
  98.   end    { k-loop }
  99. end;    { square }
  100.  
  101.  
  102. begin    { MAIN program }
  103.   get_data(x,y,nrow,ncol);
  104.   square(x,y,a,g,nrow,ncol);
  105.   write_data
  106. end.
  107.