{!!! Этот комментарий надо ПОТЕРЕТЬ перед сдачей ;-)
Тут сетка равномерная. ни в одной книшке нет частично равномерной
}

uses graph,crt;
const
      e=0.001;

type  {тип точки}
 Typea=record
  x:real;
  t:real;
  U:real;
 end;

var gd,gm,midx,midy:integer;  {для графики}
    U,Uwas,Uwaswas:array[0..1000]of Typea;  {Массивы для слоев: текущий, прошлый, позапрошлый}
    i,j:integer;
    k,ko,h,g:real;   {Для метода}
    y,z,n:integer;  {Для отладки}
    d,dd:real;    {Погрешность}

procedure banner;
begin
  clearviewport;
  settextjustify(1, 0);
  settextstyle(0,0,0);
  outtextxy(midx,round(midy*0.20),'Министерство образования и науки Украины');
  outtextxy(midx,round(midy*0.28),'Курсовая работа');
  outtextxy(midx,round(midy*0.36),'по курсу "Основы численных методов"');
  settextjustify(0, 1);
  outtextxy(round(midx/8),round(midy*0.54),'тема: ---');
  outtextxy(round(midx/8),round(midy*0.62),'цель работы: ---');

  outtextxy(midx,round(midy*1.0),'Выполнил:');
  outtextxy(midx,round(midy*1.07),'  -');
  outtextxy(midx,round(midy*1.14),'  -');
  outtextxy(midx,round(midy*1.21),'  -');
  outtextxy(midx,round(midy*1.28),'Проверил:');
  outtextxy(midx,round(midy*1.35),'  -');

  settextjustify(1, 1);
  outtextxy(midx,round(midy*1.9),'Киев 2002');
  readkey;
  clearviewport;
end;

function realU(x,t:real):real;
var q:real;
begin
 q:=sin(Pi*(x+t));
 realU:=q;
end;


procedure outstring;  {тоже для отладки, можно вытереть}
begin
 for z:=0 to 10 do
 begin
  gotoxy(5+6*z,y+2);
  write(Uwas[z].u:5:2);
 end;
 inc(y);
end;



procedure outline;  {процедура вывода сетки}
var xx,yy:real;
begin
  setcolor(8);
   for i:=1 to n-1 do
   begin
    line(round(midx+200*Uwas[i].x+100*Uwas[i].t*cos(3*Pi/4)),round(midy+100*Uwas[i].t*sin(3*Pi/4) - 50*Uwas[i].u),
         round(midx+200*Uwaswas[i].x+100*Uwaswas[i].t*cos(3*Pi/4)),round(midy+100*Uwaswas[i].t*sin(3*Pi/4) - 50*Uwaswas[i].u));
    line(round(midx+200*Uwas[i].x+100*Uwas[i].t*cos(3*Pi/4)),round(midy+100*Uwas[i].t*sin(3*Pi/4) - 50*Uwas[i].u),
         round(midx+200*Uwas[i+1].x+100*Uwas[i+1].t*cos(3*Pi/4)),round(midy+100*Uwas[i+1].t*sin(3*Pi/4) - 50*Uwas[i+1].u));
    line(round(midx+200*Uwas[i].x+100*Uwas[i].t*cos(3*Pi/4)),round(midy+100*Uwas[i].t*sin(3*Pi/4) - 50*Uwas[i].u),
         round(midx+200*Uwas[i-1].x+100*Uwas[i-1].t*cos(3*Pi/4)),round(midy+100*Uwas[i-1].t*sin(3*Pi/4) - 50*Uwas[i-1].u));
{    if keypressed then if readkey=chr(27) then exit}
   end;
   for i:=0 to n do
   begin
   putpixel(round(midx+200*Uwas[i].x+100*Uwas[i].t*cos(3*Pi/4)),round(midy+100*Uwas[i].t*sin(3*Pi/4) - 50*Uwas[i].u),11);
   end;
end;  {Тут везде одна хитрая формула. Если надо, могу прокомментировать}

function pow(x:real):real;
var r:real;
begin
 r:=x*x;
 pow:=r;
end;

procedure Cemka;
begin
 line(midx,midy,midx+200,midy);
 line(midx,midy-100,midx,midy);
 line(midx-1,midy,round(midx+100*cos(3*PI/4)),round(midy+100*sin(3*PI/4)));
 outtextxy(midx+220,midy,'x');
 outtextxy(midx,midy-120,'U');
 outtextxy(round(midx+120*cos(3*PI/4)),round(midy+120*sin(3*PI/4)),'t');
 ko:=0.25/n;
 k:=ko;h:=1/n;  {Установка начальных значений шагов}
 for i:=1 to n-1 do  {Начальное условие T=0}
 begin
   Uwas[i].x:=i*h;
   Uwas[i].t:=0;
   Uwas[i].U:=sin(Pi*i*h);
 end;
 Uwas[0].x:=0;   Uwas[0].t:=0;     Uwas[0].U:=0;  {Граничное для T=0}
 Uwas[n].x:=1;   Uwas[n].t:=0;     Uwas[n].U:=0;
{                  outstring;}
  for i:=0 to n do Uwaswas:=Uwas;
                   outline;
 for i:=0 to n do   {первый шаг, делается по производной}
 begin
  Uwas[i].x:=i*h;Uwas[i].t:=0;
  Uwas[i].U:=Uwas[i].U+k*(Pi*cos(Pi*i*h));
{  k:=k*0.95;}  {изменение шага по t коэфициент 0.95 подобран так, чтобы g=k*k/h*h < 1
               что есть условие сходимости}
 end;
                  outline;

 j:=0;
{ for j:=1 to 4*n do  }{сам цикл по t}
 while Uwas[n].t<=1 do
 begin
  inc(j);
  k:=ko;
  U[0].t:=j*k;
  for i:=1 to n-1 do {цикл по х}
  begin
{   k:=k*0.95;}
   g:=k*k/h/h;
   U[i].x:=h*i;U[i].t:=k*j;
   U[i+1].x:=(h+1)*i;U[i+1].t:=k*j;
   U[i].u:=Uwas[i].u*2*(1-g)+g*Uwas[i-1].U+g*Uwas[i+1].U-Uwaswas[i].U;
   {конечно-разностная формула ^^^^}
   if(Uwas[i].t<1)then
   begin
    if(realU(Uwas[i].x,Uwas[i].t)<>0)then
    dd:=abs( Uwas[i].u-realU(Uwas[i].x,Uwas[i].t));
    if dd>d then d:=dd;
   end;
   {нахождение погрешности^^^}
   if keypressed then if readkey=chr(27) then exit; {Запасный выход}
  end;





  for i:=1 to n-1 do  {сдвиг по слою. Новые значения становятся на место старых}
  begin
   if Uwas[i].t<1 then
   begin
    Uwaswas[i]:=Uwas[i];Uwas[i]:=U[i];
   end;
  end;
  Uwaswas[0]:=Uwas[0];  Uwaswas[n]:=Uwas[n];
  {Выбор новых граничных условий}
                 outline;
 { if Uwas[0].t<1 then
  begin}
   Uwas[0].x:=0;    Uwas[0].t:=j*ko;  Uwas[0].U:=sin(Pi*j*ko);
{  end;
  if Uwas[n].t<1 then
  begin}
  Uwas[n].x:=1;   Uwas[n].t:=j*k; Uwas[n].U:=sin(Pi*(j*k+1));
{  end;  }
{                outstring;}
 end;
end;

procedure npoBepka;
begin
 {Вывод настоящего решения}
 for j:=1 to 4*n do
 begin
  k:=0.5/n;
  for i:=1 to n-1 do
  begin
{   k:=k*0.95;}
   if(j*k<1)then
   putpixel(round(midx+200*i*h+100*j*k*cos(3*Pi/4)),round(midy+100*j*k*sin(3*Pi/4) - 50*realU(i*h,j*k)),12);
   end;
 end;
 gotoxy(10,20);write('Наибольшая погрешность: ',dd:6:5);
end;

begin
 d:=0;
 gd:=detect;   {графика}
 initgraph(gd,gm,'');
 midx:=getmaxx div 2;midy:=getmaxy div 2-40;
 directvideo:=false;
 banner;
 gotoxy(1,1);write('Введите количество шагов по оси x: ');readln(n);
 {Для заданной точности надо минимум 1200 шагов, но для демонстрации 10-ти
 вполне достаточно}
 Cemka;
 readkey;
 npoBepka;
 readkey;
 closegraph;
end.