Одномерный массив Опции

[Jangle]

Дана последовательность из n элементов. Увеличьте ее, вставив после каждого максимального элемента минимальный.

Uses Crt;
const
     n=5;
     a:array [1..N] OF INTEGER =(1,2,3,5,5);
Var
   i,j,min,max,s:Integer;
Begin
     ClrScr;
     min:=a[1];
     max:=A[1];
     For i:=2 To n Do
     If min>a[i] Then min:=a[i]
     Else
     If max<a[i] Then max:=a[i];
     i:=1;
     while i<=n+1 do
     begin
           If A[i]=max Then
           begin
                for i:=n downto i  do
                a[i+1]:=a[i];
                a[I+1]:=min;
           end;
     s:=s+1;
     i:=i+1;
     end;
     for i:=1 to s+1 do
     WriteLn(A[i]);
     ReadKey;
End.

Скажите пожалуйста в чем ошибка... Когда меняются значения массива он начинает некорректрно исполнять программу. Help! Заранее спасибо!