Ошибка в программе дхмерного массива Опции

[Дрем]

задание:
Посчитать произведения всех отрицательных элементов матрицы. Найти максимальный и минимальный элементы и поменять местами строки, в которых они находятся (если они в одной строке, вывести сообщение об этом).
n = 6 ; m = 6 ;


Программный Код:

Код

Program lab62;
Var
A:array [1..6,1..6] of real;
g,s,max,min:real;
i,j,q,w       :integer;
Begin
s:=1;
For i:= 1 to 6 do
For j:= 1 to 6 do
Begin
Write ('‚Введите элемент строки ',i,' столбца  ',j,' ');
Read (A[i,j]);
End;
for i:= 1 to 6 do
for j:= 1 to 6 do
if A[i,j]<0 then
S:= s*A[i,j];
Writeln ('Vvedenni massiv:');
Writeln;
for i:= 1 to 6 do
Begin
For j:= 1 to 6 do
Write (A[i,j]:1:0,' ');
Writeln;
End;
max:=A[1,1];
For i:= 1 to 6 do
For j:= 1 to 6 do
If A[i,j]>max then
Begin
max:=A[i,j];
q:=i;
End;
For i:= 1 to 6 do
For j:= 1 to 6 do
if A[i,j]<0 then
begin
A[i,j]:=min;
w:=i;
End;
for i:= 1 to 6 do
for j:= 1 to 6 do
if A[i,j]<min then
Begin
A[i,j]:=min;
w:=i;
End;
If q=w then
Writeln ('max i min element massiva nahodyatsa v odnoi stroke');
for j:= 1 to 6 do
Begin
g:=A[q,j];
A[q,j]:=A[w,j];
A[w,j]:=g;
End;
Writeln ('Otredaktirovanii massiv: ');
Writeln;
For i:= 1 to 6 do
Begin
For j:= 1 to 6 do
Write (A[i,j]:1:0,' ');
Writeln;
End;
Writeln ('pomenyali mestami stroki ',q:1,' i ',w:1);
Writeln ('proizv otr el massiva ravno ',s:4:2);
End.

ошибка:
при переставлении строк отрицательные элементы заменяет на нули...

вот так вот.... буду оч благодарен в помощи!!!