Неверная вещественная операция

program Anal;
uses crt;
var x,r,z1,z2,z3,s:real;
const a=2;
      b=1;                                                                                {Ñìåéñÿ, ÿ õî÷ó óñëûøàòü ãðîìêèé ñìåõ!!! Óëûáàéñÿ, ýòî ðàçäðàæàåò âñåõ!!!!!!}
      w=3;
      t=5;
      y=-1;
begin
     writeln('vvedite X');
     readln(x);
     if x<0 then
        begin
             s:=sin(b*x*x*x);
             z1:=sqrt(1-w*t*s);
             if z1=0 then
                begin
                     writeln('reshenii net, t.k. znamenatel raven nylu');
                halt end
             else
                 begin
                      r:=s/z1;
                      writeln('R=',r:5:2);
                 halt end
        end
     else
         begin
             z2:=ln(a-x);//ЗДЕСЬ!
              if z2=0 then
                 begin
                      writeln('reshenii net, t.k. znamenatel raven nylu');
                halt end
              else
                  begin
                       z3:=1+(a+y)/z2;
                       if z3=0 then
                          begin
                               writeln('reshenii net, t.k. znamenatel raven nylu');
                          halt end
                       else
                           begin
                                r:=exp(ln(1+((cos(x)+sin(x)))/z3)/3);
                                writeln('R=',r:5:2);
                           end;
                  end;
         end;
readkey;
end.

if a-x<=0 then
    begin
     writeln('reshenii net, t.k. znamenatel raven nylu');
     halt 
   end
 else
  begin
    z2:=ln(a-x);
    .................

1 Program Squares;
2 Var
3 x:Integer;
4 x1:real;
5 x2:real;
6 a:shortint;
7 b:shortint;
8 c:shortint;
9 d:Integer;
10 y:real;
11 begin
12 Writeln('введи a,b,c,y');
13 Readln(a,b,c,y);
14 y:=a*sqr(x)+b*x+c;
15 D:=sqr(b)-4*a*c;
16 If D<0 Then
17 Writeln('Корней нет')
18 Else
19 x1:=(-b+sqrt(D))/(2*a);
20 x2:=(-b-sqrt(D))/(2*a);
21 Writeln('x1=',x1:4:2, ' x2=', x2:4:2);
22 Readln;
23 end.

if D<0 Then Writeln('Корней нет')
 Else
      begin
        x1:=(-b+sqrt(D))/(2*a);
        x2:=(-b-sqrt(D))/(2*a);
        Writeln('x1=',x1:4:2, ' x2=', x2:4:2);
      end;

program Oblik;
 
 
const path='d:/14/litvin/';
 
type Tcorp=record
       name:string[20];
       dohid:Real;
       vutratu:Real;
       prubytok:Real;
     end;
     TidName=record
       id:Integer;
       val:string[20];
     end;
     TidDP=record
       id:Integer;
       val:Real;end;
 
 
 
var key:Char;
    NumDel:Integer;
    base: file of Tcorp;
    FileIdName: file of TidName;
    FileIdDP: file of TidDP;
 
 
Procedure CreateId;
var n,i,j: integer;
    ArrName: array[0..255] of TidName;
    ArrDohid: array[0..255] of TidDP;
    ArrPrubytok: array[0..255] of TidDP;
    TempRec:Tcorp;
    TempIdN:TidName;
    TempIdDP:TidDP;
begin
Assign(base,path+'base.dat');
 if FileExists(path+'base.dat')
  then Reset(base)
  else Rewrite(base);
 n:=filesize(base);
 for i:=0 to n-1 do
  begin
   read(base,TempRec);
   ArrName[i].id:=i;
   ArrName[i].val:=TempRec.name;
   ArrDohid[i].id:=i;
   ArrDohid[i].val:=TempRec.dohid;
   ArrPrubytok[i].id:=i;
   ArrPrubytok[i].val:=TempRec.dohid-TempRec.vutratu;
  end;
 Close(base);
 
 
 Assign(FileIdName,path+'idn.dat');
 Rewrite(FileIdName);
 
 for i:=n-1 downto 1 do
 for j:=0 to i-1 do
 if ArrName[j].val>ArrName[j+1].val then
 begin
  TempIdN:=ArrName[j];
  ArrName[j]:=ArrName[j+1];
  ArrName[j+1]:=TempIdN;
 end;
 
 for i:=0 to n-1 do
 write(FileIdName,ArrName[i]);
 close(FileIdName);
 
 
 Assign(FileIdDP,path+'idp.dat');
 Rewrite(FileIdDP);
 
 for i:=n-1 downto 1 do
 for j:=0 to i-1 do
 if (ArrPrubytok[j].val>ArrPrubytok[j+1].val) then
 begin
  TempIdDP:=ArrPrubytok[j];
  ArrPrubytok[j]:=ArrPrubytok[j+1];
  ArrPrubytok[j+1]:=TempIdDP;
 end;
 
 for i:=0 to n-1 do
 write(FileIdDP,ArrPrubytok[i]);
 close(FileIdDP);
 
 
 Assign(FileIdDP,path+'idd.dat');
 Rewrite(FileIdDP);
 
 for i:=n-1 downto 1 do
 for j:=0 to i-1 do
 if ArrDohid[j].val>ArrDohid[j+1].val then
 begin
  TempIdDP:=ArrDohid[j];
  ArrDohid[j]:=ArrDohid[j+1];
  ArrDohid[j+1]:=TempIdDP;
 end;
 
 for i:=0 to n-1 do
 write(FileIdDP,ArrDohid[i]);
 close(FileIdDP);
end;
 
procedure add;
var new_record: Tcorp;i:char;
begin
 Assign(base,path+'base.dat');
 if FileExists(path+'base.dat')
  then Reset(base)
  else Rewrite(base);
 Seek(base,filesize(base));
 while i<>'y' do
  begin
   Writeln('New record:');
   Write('Name:');
   Readln(new_record.name);
   Write('income:');
   Readln(new_record.dohid);
   Write('costs:');
   Readln(new_record.vutratu);
   new_record.prubytok:=new_record.dohid-new_record.vutratu;
   Writeln('profit: ',new_record.prubytok:0:2);
   write(base,new_record);
   writeln('tse vsi zapysy?');
   writeln('tak?(y)ni?(n)');
   readln(i);
   
  end;
 
 Close(base);
 CreateId;
end;
 
procedure Print;
var key:char;
    i:Integer;
    TempRec:Tcorp;
    TempIdN:TidName;
    TempIdDP:TidDP;
begin
Writeln('+-Sort-by:---+--------------+--------------+-------------+');
Writeln('| By name(1) | By income(2) | By profit(3) |   Return(0) |');
Writeln('+------------+--------------+--------------+-------------+');
Readln(Key);
 
Assign(base,path+'base.dat');
Reset(base);
 case key of
 '1':begin
      Writeln('Sort by name');
      Assign(FileIdName,path+'idn.dat');
      Reset(FileIdName);
      for i:=0 to filesize(base)-1 do
       begin
        Read(FileIdName,TempIdN);
        Seek(base,TempIdN.id);
        Read(base,TempRec);
        Writeln (TempRec.name,'   ',TempRec.dohid :0:2,'   ',TempRec.vutratu :0:2,'   ',TempRec.prubytok:0:2);
       end;
      Close(FileIdName);
     end;
 '2':begin
      Writeln('Sort by income');
      Assign(FileIdDP,path+'idd.dat');
      Reset(FileIdDP);
      for i:=0 to filesize(base)-1 do
       begin
        Read(FileIdDP,TempIdDP);
        Seek(base,TempIdDP.id);
        Read(base,TempRec);
        Writeln (TempRec.name,'   ',TempRec.dohid :0:2,'   ',TempRec.vutratu :0:2,'   ',TempRec.prubytok:0:2);
       end;
      Close(FileIdDP);
     end;
 '3':begin
      Writeln('Sort by profit');
      Assign(FileIdDP,path+'idp.dat');
      Reset(FileIdDP);
      for i:=0 to filesize(base)-1 do
       begin
        Read(FileIdDP,TempIdDP);
        Seek(base,TempIdDP.id);
        read(base,TempRec);
        Writeln (TempRec.name,'   ',TempRec.dohid :0:2,'   ',TempRec.vutratu :0:2,'   ',TempRec.prubytok:0:2);
        end;
      Close(FileIdDP);
     end;
 else if key<>'0' then writeln (' ERROR: unknown command ',key);
 end ;
Close(base);
writeln ('Press enter to continue.');
Readln;
end;
 
procedure Delete(row:Integer);
var TempBase:Tcorp;
begin
Assign(base,path+'base.dat');
Reset(base);
seek(base,filesize(base)-1);
read(base,TempBase);
seek(base,row);
write(base,TempBase);
seek(base,filesize(base)-1);
Truncate(base);
Close(base);
CreateId;
Writeln('Deleting was successful.');
writeln ('Press enter to continue.');
Readln;
end;
 
procedure search;
var key:Char;
    TempIdName:TidName;
    TempIdDP:TidDP;
    TempRec:Tcorp;
    name:string[20];
    l,r,c:Integer;
    found:Boolean;
    p:Integer;
    min,max:Real;
begin
Writeln('+-Search-by:-+--------------+--------------+-------------+');
Writeln('| By name(1) | By income(2) | By profit(3) |   Return(0) |');
Writeln('+------------+--------------+--------------+-------------+');
Readln(key);
 
Assign(base,path+'base.dat');
Reset(base);
 case key of
 '1':begin
      Assign(FileIdName,path+'\idn.dat');
      Reset(FileIdName);
      Write('Name: ');
      Readln(name);
      r:=filesize(FileIdName)-1;
      l:=0;
      found:=False;
      while (l<=r) and (not found) do
       begin
        c:=(l+r) div 2;
        Seek(FileIdName, c);
        read(FileIdname,TempIdName);
        if name < TempIdName.val then r:=c-1
        else if name > TempIdName.val then l:=c+1
        else
        begin
         found:=True;
         p:=c;
         while name=TempIdName.val do
          begin
           Seek(base,TempIdName.id);
           Read(base,TempRec);
           Writeln (TempRec.name,'   ',TempRec.dohid :0:2,'   ',TempRec.vutratu :0:2,'   ',TempRec.prubytok:0:2);
           if p-1<0 then Break;
           p:=p-1;
           Seek(FileIdName, p);
           read(FileIdname,TempIdName);
          end;
 
         p:=c+1;
         if p<FileSize(FileIdName) then
         begin
          Seek(FileIdName, p);
          read(FileIdname,TempIdName);
          while name=TempIdName.val do
           begin
            Seek(base,TempIdName.id);
            Read(base,TempRec);
            Writeln (TempRec.name,'   ',TempRec.dohid :0:2,'   ',TempRec.vutratu :0:2,'   ',TempRec.prubytok:0:2);
            if p+1>=FileSize(FileIdName) then Break;
            p:=p+1;
            Seek(FileIdName, p);
            read(FileIdname,TempIdName);
           end;
         end;
        end;
       end;
     end;
 '2':begin
      Assign(FileIdDP,path+'\idn.dat');
      Reset(FileIdDP);
      Write('Value: ');
      Readln(min);
      r:=filesize(FileIdDP)-1;
      l:=0;
      found:=False;
      while (l<=r) and (not found) do
       begin
        c:=(l+r) div 2;
        Seek(FileIdDP, c);
        read(FileIdDP,TempIdDP);
        if min> TempIdDP.val then l:=c+1
        else if min <= TempIdDP.val then
        begin
         found:=True;
         p:=c;
         while min<=TempIdDP.val do
          begin
           Seek(base,TempIdDP.id);
           Read(base,TempRec);
           Writeln (TempRec.name,'   ',TempRec.dohid :0:2,'   ',TempRec.vutratu :0:2,'   ',TempRec.prubytok:0:2);
           if p-1<0 then Break;
           p:=p-1;
           Seek(FileIdDP, p);
           read(FileIdDP,TempIdDP);
          end;
 
         p:=c+1;
         if p<FileSize(FileIdDP) then
         begin
          Seek(FileIdDP, p);
          read(FileIdDP,TempIdDP);
          while p<FileSize(FileIdDP) do
           begin
            Seek(base,TempIdName.id);
            Read(base,TempRec);
            Writeln (TempRec.name,'   ',TempRec.dohid :0:2,'   ',TempRec.vutratu :0:2,'   ',TempRec.prubytok:0:2);
            if p+1>=FileSize(FileIdDP) then Break;
            p:=p+1;
            Seek(FileIdName, p);
            read(FileIdDP,TempIdDP);
           end;
         end;
        end;
       end;
     end;
 
 else if key<>'0' then writeln (' ERROR: unknown command ',key);
 end;
 
Close(base);
if not found then Writeln('Not found!');
writeln ('Press enter to continue.');
Readln;
end;
 
 
 
begin
key:=#0;
while key<>'0' do
 begin
  Writeln('+--------+-----------+-----------+----------+------------+');
  Writeln('| Add(1) | Delete(2) | Search(3) | Print(4) |    Exit(0) |');
  Writeln('+--------+-----------+-----------+----------+------------+');
  Readln(key);
  case key of
   '1':add;
   '2':begin
        Writeln('Enter number of record for deletion. Enter "-1" for return to main menu.');
        Readln(NumDel);
        if NumDel>=0 then  Delete(NumDel);
       end;
   '3':Search;
   '4':Print;
   else if key<>'0' then writeln (' ERROR: unknown command ',key);
  end;
 end;
 
end.

Readln(key);
  case key of
   '1':add;
   '2':begin
        Writeln('Enter number of record for deletion. Enter "-1" for return to main menu.');
        Readln(NumDel);
        if NumDel>=0 then  Delete(NumDel);
       end;
   '3':Search;
   '4':Print;
   else if key<>'0' then writeln (' ERROR: unknown command ',key);

program abc;
var
A,B,C,X,Y,Y1,Y2 : real;
begin
cls;
writeLn('Введите A');
readLn(A);
writeLn('Введите B');
readLn(B);
writeLn('Введите C');
readLn(C);
Y1:=sin(exp(3*ln(A))+sqr(B)+C);
Y2:=cos(exp(3*ln(A))+sqr(B)+C);
Y:= Y1/Y2;
x:=((exp(3*ln(A)))+sqr(B)+C)*(Y-arctan((1/abs(A))/sqrt(1-sqr(abs(A)))));
writeLn('Вы ввели:');
writeLn('A=', A, ' B=', B, ' C=', C);
writeLn(' Числитель в аргументе тригонометрических функций равен ', Y1, ',');
writeLn('а знаменатель ',Y2,', потому их отношение равно ', Y);
writeLn('Значит вся формула получается X=', X);
writeLn('В отформатированном виде X=', X:8:3);
end.

sqrt(abs(1-sqr(A))))

program abc;
uses crt;
var
A,B,C,X,Y,Y1,Y2,Z,M : real;
begin
clrscr;
writeLn('Введите A');
readLn(A);
if abs(a)<1 then
 begin
  writeln('При А=',A:0:2,' не определено значение arcsin');
  readln;
  exit;
 end;
writeLn('Введите B');
readLn(B);
writeLn('Введите C');
readLn(C);
Y1:=sin(exp(3*ln(A))+sqr(B)+C);
Y2:=cos(exp(3*ln(A))+sqr(B)+C);
if Y2=0 then
  begin
   writeln('Деление на 0, решения нет');
   readln;
   exit;
  end;
Y:= Y1/Y2;
if A=1 then X:=pi/2
else X:=arctan(((1/abs(A)))/sqrt(1-sqr(1/abs(A))));
Z:=a*a*a+b*b+c;
M:=Z*(Y-X);
writeLn('Вы ввели:');
writeLn('A=', A, ' B=', B, ' C=', C);
writeLn(' Числитель в аргументе тригонометрических функций равен ', Y1:0:2, ',');
writeLn('а знаменатель ',Y2:0:2,', потому их отношение равно ', Y:0:2);
writeLn('Значит вся формула получается M=', M);
writeLn('В отформатированном виде M=', M:0:3);
readln;
end.

program abc;
var
A,B,C,X,Y,Y1,Y2 : real;
begin
cls;
writeLn('введите A');
readLn(A);
writeLn('введите B');
readLn(B);
writeLn('введите C');
readLn(C);
Y1:=sqrt(sqr(A)+sqr(B))/(0.5 + A*B) - 1/A;
Y2:=C+abs(A-B);
Y:= Y1/Y2;
X:= exp(-A/B)*(sin(Y)+cos(Y));
writeLn('Вы ввели:');
writeLn('A=', A, ' B=', B, ' C=', C);
writeLn('Числитель в аргументе тригонометрических
функций равен ', Y1, ',');
writeLn('а знаменатель ',Y2,
', потому их отношение равно ', Y);
writeLn('Значит вся формула получается X=', X);
writeLn('В отформатированном виде X=', X:8:3);
end.