1. Pascal / Говнокод #8227

    +145

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    program gays;
uses crt;
var k,k1,kn,n,i,j:integer;
    a,c:array [1..100,1..100] of real;
    f,x,b,d:array [1..100] of real;
    r:real;
begin
  repeat
  Write ('put poriadok n<100, n=');
  readln(n);
  until n<100;
  for i:=1 to n do
   begin
     for j:=1 to n do
      begin
        write('a [',i,';',j,']=');
        readln(a[i,j]);
        c[i,j]:=a[i,j];
      end;
     write('b [',i,']=');
     readln(b[i]);
     d[i]:=b[i];
   end;
 //3blok
  for k:=1 to (n-1) do
   begin
     //4 blok
     if a[k,k]=0 then
      begin
         k1:=k;
         repeat
          k1:=k1+1 ;
         until (a[k1,k]<>0) or (k1>n);
         if a[k1,k]=0 then
          begin
            writeln('Vedushii elementi ravni nuly');
            halt;
          end;
         kn:=k1;
         for j:=1 to n do
          begin
            r:=a[k,j];
            a[k,j]:=a[kn,j];
            a[kn,j]:=r;
          end;
          r:=b[k];
          b[k]:=b[kn];
          b[kn]:=r;
      end;
          //5 blok
     b[k]:=b[k]/a[k,k];
     for i:=(k+1) to n do
       b[i]:=b[i]-a[i,k]*b[k];
     for j:=(k+1) to n do
      begin
        a[k,j]:=a[k,j]/a[k,k];
        for i:=(k+1) to n do
          a[i,j]:=a[i,j]-a[i,k]*a[k,j];
      end;
   end;
  //end 3 blok
  x[n]:=b[n]/a[n,n];
  // 7 blok

  for i:=(n-1) downto 1 do
   begin
     for j:=i+1 to n do
       b[i]:=b[i]-x[j]*a[i,j] ;
     x[i]:=b[i];
   end;

   // 8 blok
   for i:=1 to n do
     if x[i]<0 then writeln ('nomer otricatelnogo kornia =',i);
   for j:=1 to n do writeln('x[',j,']=',x[j]:10:4);
   // 9 blok
   for i:=1 to n do
    begin
      f[i]:=-d[i];
      for j:=1 to n do
        f[i]:=f[i]+c[i,j]*x[j];
      writeln('F=',f[i]:10:4);
    end;
readkey;
end.

    Очередной высер стажера при написании учетного решения в 1С

    Запостил: alexoy, 18 Октября 2011

    Комментарии (14) RSS

    Добавить комментарий