Cod sursa(job #482812)

Utilizator superman13Stefan Maimescu superman13 Data 5 septembrie 2010 12:59:38
Problema Al k-lea termen Fibonacci Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.32 kb
Program Iepurasii;
const K = 70; { numarul de cifre ale numerelor foarte mari }
type Cifra = 0..9;
Numar = array[1..K] of Cifra;
var n : integer;
S : Numar;
procedure Citeste;
{ Citeste numarul n din fisierul de intrare }
var Intrare : text;
begin
assign(Intrare, 'kfib.in');
reset(Intrare);
readln(Intrare, n);
close(Intrare);
end; { Citeste }
procedure Scrie;
{ Scrie suma S in fisierul de iesire }
var Iesire : text;
j : integer;
begin 
assign(Iesire, 'kfib.out'); 
rewrite(Iesire); 
j:=1; 
while S[j]=0 do j:=j+1; 
while j<=K do begin write(Iesire, S[j]); 
j:=j+1; 
end; 
{ while } writeln(Iesire); 
close(Iesire); 
end; 
{ Scrie } procedure Unu(var A : Numar); 
{ Atribuie numarului A valoarea 1 } var j : integer; 
begin for j:=1 to K-1 do A[j]:=0;
A[K]:=1; 
end; { Unu }
procedure Adunare(A, B : Numar; var C : Numar); { Calculeaza suma C:=A+B } var Transport : Cifra; j : integer; q : 0..19; begin Transport:=0; for j:=K downto 1 do begin q:=A[j]+B[j]+Transport; if q<=9 then Transport:=0 else begin Transport:=1; q:=q-10; end; C[j]:=q; end; { for } if Transport=1 then begin writeln('Depasire'); readln; end; end; { Adunare } procedure Suma; var i : integer; F1, F2, F3 : Numar;
begin Unu(F1); Unu(F2); S:=F1; i:=2; repeat Adunare(F2, S, S); Adunare(F1, F2, F3); F1:=F2; F2:=F3; i:=i+1; until i>n; end; { Suma }
begin
Citeste;
Suma;
Scrie;
end.