Программки на массивы...циклические процессы и т.д, Нуфно переделать программку Опции

[Lapochka]

Приветик всем Вот почти не разбираюсь я в паскале...а лабы хоть убейся, но сдать надо
Вопщем сразу перейду к делу, надо переделать программку, так, что бы она выполнялась с циклом while.Заранее респект

program Lapochka; 
Uses Crt;
const 
  gl=['a','e','i','o','u','y']; 
   so=['b','c','d','f','g','h','j','k','l',
         'm','n','p','r','s','t','w','q','t','v','z'];
 var
   a: string; 
     g,s,i:integer; 
begin 
clrscr;
TextColor(Yellow);
  write('Vvedite posledovatelnost '); readln(a); 
    g:=0; s:=0; 
      for i:= 1 to length(a) do 
        if a[i] in gl then inc(g) else if a[i] in so then inc(s);
        if g> s then 
writeln('TRUE')
    else if g< s then writeln('FALSE');
 readln; 
end. 

А вот ещё...если у кого то ум позволяет щёлкать, как орешки эти программки

1)Нуфно сделать с помощью одномерных массивов :Даны действительные числа а1,...,aN. Требуется найти максимальное значение из этих чисел и отклонение от максимального для каждого из них.

2)Нуфно сделать с помощью сортировки массива: Переставить строки исходной матрицы так, чтобы убывало количество нулей в строках.

3)Нуфно спрограммировать с использованием файлов : Дана вещественная матрица размером 7´4. Найти максимальный элемент матрицы. Переставляя ее строки и столбцы, добиться того, чтобы мах элемент оказался в левом верхнем углу матрицы.

4)Спрограммировать с помощью циклич процессов (for) Ребят это срочно нужно....напишите плиз
S = 1/sqrt(1×) + 1/sqrt(3×5) + ... + 1/sqrt(199×201).

5)Не сочтите за наглость...но плиз ещё одну...я так заколебалась их делать
Сделать с использованием нескольких процедур: . Список внутренних телефонов организации с разбивкой по отделам. Количество отделов и телефонов внутри отдела задать самостоятельно. Составить модуль поиска всех телефонов с заданными двумя первыми цифрами.

Пасиба ребят

[Lapochka]

И так)Нашла две программки....по идее, если обьединить, то должно получиться, что то вроди этого-Переставить строки исходной матрицы так, чтобы убывало количество нулей в строках.
Помогите плиз их соединить

program EnterMatr;
const
  MAXCOUNT = 50; {максимальная размерность матрицы}
type
  {квадратная матрица}
  Matrix = array [1..MAXCOUNT, 1..MAXCOUNT] of real;
var
  matr: Matrix;
  n: integer; {реальная размерность матрицы}
 
(*----------------------------------------
Ввод размерности матрицы
----------------------------------------*)
procedure EnterMatrixSize(var x: integer);
begin
  repeat
    write('vvedite kol.stolbcov (1..',MAXCOUNT,') ');
    readln(x);
    if (x<1) then
      writeln('Ошибка! Размерность матрицы не может быть '+
      'меньшей единицы. Повторите ввод.');
    if (x>MAXCOUNT) then
      writeln('Ошибка! Размерность матрицы не должна быть '+
      'большей ',MAXCOUNT,'. Повторите ввод.');
  until (x>0)and(x<=MAXCOUNT);
end;
 
(*----------------------------------------
Поэлементный ввод квадратной матрицы с клавиатуры
----------------------------------------*)
procedure EnterMatrix (x: integer; var M: Matrix);
var
  i,j: integer;
begin
  writeln('Vvedite element. matrici:');
  for i:=1 to x do
    for j:=1 to x do begin
      write('M[',i,',',j,'] = ');
      readln(M[i,j]);
    end;
end;
 
(*----------------------------------------
Поэлементный вывод матрицы на экран в
"естественном" виде (т.е. по строкам)
----------------------------------------*)
procedure PrintMatrix(x: integer; M: Matrix);
var
  i,j: integer;
begin
  for i:=1 to x do begin
    for j:=1 to x do
      write(M[i,j]:6:2);
    writeln;
  end;
end;
 
{основная программа}
begin

  EnterMatrixSize(n);
  EnterMatrix(n, matr);
  writeln('Matrica:');
  PrintMatrix(n, matr);
  writeln('Enter-exit');
  readln;
end.

Вот эта должна печатать матрицу, а та, что ниже удаляет нолики)

program z14;
uses crt;
var m,i,k:longint; a:array[1..100]of longint;
 begin
  clrscr;
   write('введите кол-во элм таблицы: ');readln(k);
   for i:=1 to k do
    begin
     write('a[',i,']=');readln(a[i]);
    end;
   m:=0;
   for i:=1 to k do
   if a[i]=0 then inc(m)
             else a[i-m]:=a[i];k:=k-m;
   for i:=1 to k do write(a[i],' ');readln;
 end.