В той матрице, на главной диагонали которой все цифры, найти наименьшую и удалить соответствующую строку

Program proizvedenie;
uses crt;
const n=3;
Type Matrix=array [1..n, 1..n] of char;
Var
  A, B, C: matrix;
  i, j: byte;
  trans: char;
procedure matr(var d: matrix);
Var i,j:integer;
begin
Writeln('');
For i:=1 to N do
For j:=1 to N do
begin
Write('[',i,',',j,']=');
Readln(d[i,j]);
end;
writeln;
end;
 
function find(d: matrix): boolean;
Var i,j:integer;
begin
for i := 1 to N do
for j := 1 to N do
if(d[i, j] in ['a', 'e', 'u', 'i', 'y', 'o', 'E', 'U', 'I', 'O', 'A', 'Y', 'а', 'е', 'ё', 'и', 'о', 'у', 'ы', 'э','ю','я','А','Е','Ё','И','О','У','Ы','Э','Ю','Я']) then begin
result := true;
break;
end;
end;
 
procedure transp(var D: matrix);
Var i,j:integer;
begin
for i:= 2 to N do
for j :=1 to i-1 do begin
trans := d[i, j];
d[i, j] := d[j, i];
d[j, i] := trans;
end;
end;
 
begin
clrscr;
matr(a);
matr(b);
matr(c);
if(find(a)) then transp(a);
if(find(b)) then transp(b);
if(find(c)) then transp(c);
for i := 1 to N do begin
for j := 1 to N do write(a[i, j], ' ');
writeln('');
end;
writeln('');
for i := 1 to N do begin
for j := 1 to N do write(b[i, j], ' ');
writeln('');
end;
writeln('');
for i := 1 to N do begin
for j := 1 to N do write(c[i, j], ' ');
writeln('');
end;
readln;
end.

CONST
    N = 3;
    inf = 1 shl 30;
TYPE
 myArray = array[1..N, 1..N] of char;
 myArray2 = array[1..N - 1, 1..N] of char;
var
  m1, m2, m3: myArray;
  m11, m22, m33: myArray2;
  i, j, code, dig, str, k: integer;
  temp: char;
 
procedure ReadM(var m: myArray);
Var i,j:integer;
begin
    for i := 1 to N do
       for j := 1 to N do readln(m[i, j]);
end;
 
function vowel(m: myArray): boolean;
Var i,j:integer;
begin
    result := false;
    for i := 1 to N do
       for j := 1 to N do
           if(m[i, j] in ['a', 'e', 'u', 'i', 'o', 'E', 'U', 'I', 'O', 'A']) then begin
               result := true;
               break;
           end;
end;
 
procedure transp(var m: myArray);
Var i,j:integer;
begin
   for i:= 1 to N do
       for j := i + 1 to N do begin
           temp := m[i, j];
           m[i, j] := m[j, i];
           m[j, i] := temp;
       end;
end;
 
function digits(m: myArray; var ind: integer): boolean;
Var i,j:integer;
begin
   dig := inf;
   result := false;
   for i := 1 to N do begin
       code := ord(m[i, j]) - 48;
       if((code >= 0) and (code < 10)) then begin
           result := true;
           if(dig > code) then begin
                  dig := code;
                  ind := i;
           end;
       end;
   end;
end;
 
procedure moveMatr(m1: myArray; var m2: myArray2; ind: integer);
Var i,j:integer;
begin
    k := 0;
    for i := 1 to N do
        if(i <> ind) then begin
             inc(k);
             for j := 1 to N do   m2[k, j] := m1[i, j];
        end;
end;
 
begin
    ReadM(m1);
    ReadM(m2);
    ReadM(m3);
    if(vowel(m1)) then     transp(m1);
    if(vowel(m2)) then     transp(m2);
    if(vowel(m3)) then     transp(m3);
 
    if(digits(m1, str)) then begin
       moveMatr(m1, m11, str);
       for i := 1 to N - 1 do begin
           for j := 1 to N do     write(m11[i, j], ' ');
           writeln('');
       end;
    end else begin
       for i := 1 to N do begin
           for j := 1 to N do     write(m1[i, j], ' ');
           writeln('');
       end;
    end;
    writeln('');
    if(digits(m2, str)) then begin
       moveMatr(m2, m22, str);
       for i := 1 to N - 1 do begin
           for j := 1 to N do     write(m22[i, j], ' ');
           writeln('');
       end;
    end else begin
       for i := 1 to N do begin
           for j := 1 to N do     write(m2[i, j], ' ');
           writeln('');
       end;
    end;
    writeln('');
    if(digits(m3, str)) then begin
       moveMatr(m3, m33, str);
       for i := 1 to N - 1 do begin
           for j := 1 to N do     write(m33[i, j], ' ');
           writeln('');
       end;
    end else begin
       for i := 1 to N do begin
           for j := 1 to N do     write(m3[i, j], ' ');
           writeln('');
       end;
    end;
    writeln('');
    readln();
end.

const mi = 5;
      mc = 3;
type arr = array[1..mi, 1..mi] of char;
 
procedure ReadM(var x: arr; var r: integer; q: integer);
var i, j: integer;
begin
  repeat
    write('Введите ранг матрицы M', q, ' в диапазоне 1..', mi, ': ');
    readln(r)
  until r in [1..mi];
  writeln('Введите элементы матрицы M', q);
  for i := 1 to r do
    for j := 1 to r do
      begin
        write('M', q, '[', i, ', ', j, '] = ');
        readln(x[i, j])
      end
end;
 
procedure TestM(var x: arr; r: integer; var min: integer);
var i: integer;
begin
  min := 0;
  for i := 1 to r do
    if not (x[i, i] in ['0'..'9'])
      then begin
        min := 0;
        break
      end
      else if (min = 0) or (x[i, i] < x[min, min])
        then min := i
end;
 
procedure DelS(var x: arr; r, k: integer);
var i, j: integer;
begin
  for i := k to r do
    for j := 1 to r do
      x[i, j] := x[i + 1, j]
end;
 
procedure PrnM(var x: arr; s: string; q, v, h: integer);
var i, j: integer;
begin
  writeln(s, q, ':');
  for i := 1 to v do
    begin
      for j := 1 to h do write(x[i, j]:2);
      writeln
    end
end;
 
var m: array[1..mc] of arr;
    rg: array[1..mc] of integer;
    i, k: integer;
begin
  for i := 1 to mc do ReadM(m[i], rg[i], i);
  for i := 1 to mc do
    begin
      PrnM(m[i], 'Матрица M', i, rg[i], rg[i]);
      TestM(m[i], rg[i], k);
      if k = 0
        then writeln('На главной диагонали матрицы есть символы, отличные от цифр')
        else begin
          writeln('Минимальная цифра в строке ', k);
          DelS(m[i], rg[i], k);
          PrnM(m[i], 'Изменённая матрица M', i, rg[i] - 1, rg[i]);
        end;
      write('Нажмите <Enter> для продолжения');
      readln
    end;
  write('Нажмите <Enter> для выхода из программы');
  readln
end.