mảng trong pascal.

program sun;
uses crt;
const nmax=100;
var a:array[1..nmax]of real;
      n,x:integer;
procedure nhap;
  var i:integer;
  begin
          write('Nhap so phan tu: ');readln(n);
          for i:=1 to n do
                write('Nhap so thu ',i,': ');readln(a[i]); inc(i);
  end;
procedure dc(var i,j:integer);
  begin
          a[i]:=a[i]+a[j];a[j]:=a[i]-a[j];a[i]:=a[i]-a[j];
  end;
procedure sap_xep;
  var i:integer;
  begin
          for i:=1 to n do
              for j:= 1 to n do
                    if a[i]>a[j] then dc(i,j);
  end;
procedure chen(x,i:integer);
  var j:integer;
  begin
          for j:=n+1 downto i+1 do a[j]:=a[j-1];
          a[i]:=x;
  end;
procedure tim(x:integer);
  var i:integer;
  begin
          for i:=1 to n do
                if x<=a[i] then
                  begin
                          if x=a[i] then begin writeln('Co');exit; end
                          else chen(x);
                  end;
  end;
BEGIN
        clrscr;
        nhap;
        sap_xep;
        write('Nhap so can tim: ');readln(x);
        tim(x);
        readln;
END.

procedure nhap;
  var i:integer;
  begin
          write('Nhap so phan tu: ');readln(n);
          for i:=1 to n do
                begin
                write('Nhap so thu ',i,': ');readln(a[i]);
                end;
                { inc(i);}
  end;

procedure dc(var i,j:integer);
  begin
          a[i]:=a[i]+a[j];a[j]:=a[i]-a[j];a[i]:=a[i]-a[j];
  end;
procedure sap_xep;
  var i:integer;
  begin
          for i:=1 to n do
              for j:= 1 to n do
                    if a[i]>a[j] then dc(i,j);
  end;

var i,j:integer;
tam: real;
  begin
          for i:=1 to n - 1 do
              for j:= i + 1 to n do
                    if a[i]>a[j] then
                    begin
                    tam:=a[j];
                    a[j] := a[i];
                    a[i] := tam;
                    end;
  end;

procedure chen(x,i:integer);
  var j:integer;
  begin
          for j:=n+1 downto i+1 do a[j]:=a[j-1];
          a[i]:=x;
  end;

program mang_thuc;
uses crt;
var a:array[1..100] of real;
   i, j, n: integer;
   tam, x: real;
   kt: boolean;
begin
   clrscr;
   writeln('nhap vao so luong phan tu cua mang: ');
   readln(n);
{**** Nhap mang. ****}   
   for i := 1 to n do
      begin
         write('nhap vao phan tu thu ',i,' cua mang: ');
         readln(a[i]);
      end;
{**** ket thuc nhap mang bat dau sap xep. ****}      
   for i := 1 to n - 1 do
      for j := i + 1 to n do
         if a[i] > a[j] then
            begin
               tam := a[i];
               a[i] := a[j];
               a[j] := tam;
            end;
{**** ket thuc sap xep, bat dau in ra mang da sap xep. ****}            
   writeln('mang sau khi sap xep la:');
   for i := 1 to n do
      write(a[i]:6);
{**** ket thuc in, xuong dong, nhap vao 1 so thuc x. ****}      
   writeln;
   writeln('nhap vao 1 so thuc:');
   readln(x);
{**** gan kt = false de lam bien danh dau. ****}   
   kt := false;
{**** ket thuc nhap, bat dau kiem tra x co nam trong mang hay khong. ****}
{**** neu x nam trong mang thi xuat ra tat ca cac vi tri cua x. ****}
{**** va dung bien kt = true de danh dau x co trong mang. ****}      
   for i := 1 to n do
      if x = a[i] then
         begin
            write(i:6);
            kt := true;
         end;
{**** ket thuc kiem tra x, neu x co trong mang thi bo qua day lenh sau. ****}
{**** neu x khong co trong mang thi thuc hien day lenh duoi. ****}            
   if kt = false then
      begin
         for i := n downto 0 do
            begin
               j := i + 1;               
               {**** x lon nhat, nam trong mang hoac x la nho nhat thi deu thuc hien. ****}   
               if (x > a[i]) and (kt = false) then
                  begin
                     a[j] := x;
                     kt := true;
                  end
               {**** neu x la lon nhat hoac x khong lon nhat. ****}
               {**** nhung  dieu kien tren  da duoc thuc hien 1 lan thi lam. ****}
               else if (x > a[i]) and (kt = true) then
                  a[j] := a[i + 1]
               {**** khi x la nho nhat thi lam. ****}
               else
                  a[j] := a[i];
               end;
{**** ket thuc chen x vao mang, in mang da sap xep ra man hinh. ****}         
         writeln('mang sau khi chen la:');
         for i := 1 to n + 1 do
            write(a[i] : 6);
      end;   
{**** ket thuc chuong trinh. ****}
   readln;
end.