DEVOIR PRATIQUE BAC 2013 G3

program DevoirPratiqueBAC2013_14h;
uses wincrt;
type
mat=array[1..20,1..20] of integer;
enreg=record
nl,icd,icf:integer;
end;
tab=array[1..20]of enreg;
var
m:mat;
l,c,i:integer;
t:tab;
e:enreg;
f:text;
procedure saisirlec(var l,c:integer);
begin
repeat
writeln('entrer l');
readln(l);
until(l>2)and(l<=24);
repeat
writeln('entrer c');
readln(c);
until(c>2)and(c<=24);
end;
procedure remplirmat(var m:mat; l,c:integer);
var
li,co:integer;
begin
for li:=1 to l do
begin
for co:=1 to c do
begin
repeat
writeln('M[',li,',',co,']=');
readln(m[li,co]);
until(m[li,co]<>0);
end;
end;
end;
procedure verifier(li,c:integer; var e : enreg; var t:tab ; var i :integer;m:mat);
var
k,j,s:integer;
begin
k:=1;
while k<=c do
begin
s:=0;
for j:=k to c do
begin
s:=s+m[li,j];
if s=0 then
begin
e.nl:=li;
e.icd:=k;
e.icf:=j;
t[i]:=e;
inc(i);
s:=m[li,j];
end;
end;
inc(k);
end;
end;
procedure remptab(var t:tab; e:enreg;l,c:integer; var i:integer);
var
li:integer;
begin
i:=1;
for li:=1 to l do
begin
verifier(li,c,e,t,i,m);
end;
end;
function maxseq(t:tab;i:integer):integer;
var
m,j:integer;
begin
m:=t[1].icf-t[1].icd;
for j:=2 to i-1 do
begin
if m<(t[j].icd-t[j].icf)then
m:=t[j].icf-t[j].icd;
end;
maxseq:=m;
end;
procedure rempf(var f:text; t:tab; i:integer);
var
max,j:integer;
begin
rewrite(f);
max:=maxseq(t,i);
for j:=1 to i-1 do
begin
if (t[j].icf-t[j].icd)=max then
writeln(f,t[j].nl,'#',t[j].icd,'#',t[j].icf);
end;
close(f);
end;
begin
assign(f,'d:/Long_seq.txt');
saisirlec(l,c);
remplirmat(m,l,c);
remptab(t,e,l,c,i);
rempf(f,t,i);
end.