program givrun(input, output);
{dr03a.PAS ==  driver for Givens' reduction of a matrix

          Copyright 1988 J.C.Nash
}

const
     banner = 'dr03a.pas -- driver for Givens'' reduction';

#include "common.inc.pas"  // constants, types & procedures
#include "calceps.pas"     // compute machine precision
#include "matrixin.pas"    // input or generate a matrix of reals
#include "alg03a.pas"      // Givens reduction of a matrix
{Replace the last include file with alg03a.pas to get a
  row-wise version of the Givens' reduction.}

var
  A, Q: rmatrix;
  i, j, k, nRow, nCol : integer;
  Acopy : rmatrix;
  avec: smatvec; {for matrixin only}
  sym : boolean; {for matrixin only}
  s : real;

begin
  startup;
  write('Size of problem (rows, columns) ');
  readln(infile,nRow,nCol); if not isConsole then writeln(nRow,' ',nCol);
  writeln(confile,'Size of problem (rows, columns) ',nRow,' ',nCol);
  matrixin(nRow,nCol,A,avec,sym);
  writeln('Matrix A');
  writeln(confile,'Matrix A');
  for i:=1 to nRow do
  begin
    for j:=1 to nCol do
    begin
      Acopy[i,j]:=A[i,j];
      write(A[i,j]:10:5,' ');
      write(confile,A[i,j]:10:5,' ');
      if (7 * (j div 7) = j) and (j<nCol) then
      begin
        writeln;
        writeln(confile);
      end;
    end;
    writeln;
    writeln(confile);
  end;
  givens(nRow,nCol,A,Q);
  writeln('Decomposition');
  writeln(confile,'Decomposition');
  writeln('Q');
  writeln(confile,'Q');
  for i:=1 to nRow do
  begin
    for j:=1 to nRow do
    begin
      write(Q[i,j]:10:5,' ');
      write(confile,Q[i,j]:10:5,' ');
      if (7 * (j div 7) = j) and (j<nRow) then
      begin
        writeln;
        writeln(confile);
      end;
    end;
    writeln;
    writeln(confile);
  end;
  writeln('R');
  writeln(confile,'R');
  for i:=1 to nRow do
  begin
    for j:=1 to nCol do
    begin
      write(A[i,j]:10:5,' ');
      write(confile,A[i,j]:10:5,' ');
      if (7 * (j div 7) = j) and (j<nCol) then
      begin
        writeln;
        writeln(confile);
      end;
    end;
    writeln;
    writeln(confile);
  end;
  writeln('Q*R - Acopy');
  writeln(confile,'Q*R - Acopy');
  for i:=1 to nRow do
  begin
    for j:=1 to nCol do
    begin
      s:=-Acopy[i,j];
      for k:=1 to nRow do s:=s+Q[i,k]*A[k,j];
      write(s:10,' ');
      write(confile,s:10,' ');
      if (7 * (j div 7) = j) and (j<nRow) then
      begin
        writeln;
        writeln(confile);
      end;
    end;
    writeln;
    writeln(confile);
  end;
    {local files auto closed when procedure ends}
end. {dr03a.pas == Givens' reduction driver}
