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