code 35030; procedure INCOMGAM(X,A,KLGAM,GRGAM,GAM,EPS); value X,A,EPS; real X,A,KLGAM,GRGAM,GAM,EPS; begin real C0,C1,C2,D0,D1,D2,X2,AX,P,Q,R,S,R1,R2,SCF; integer N; S:= EXP(-X + A * LN(X)); SCF:= "+300; if X <= (if A < 3 then 1 else A) then begin X2:= X * X; AX:= A * X; D0:= 1; P:= A; C0:= S; D1:=(A+1)*(A+2-X); C1:=((A+1) * (A+2)+X) * S; R2:= C1/D1; for N:= 1, N+1 while ABS((R2-R1)/R2) > EPS do begin P:= 2+P; Q:= (P+1) * (P*(P+2)-AX); R:= N * (N+A) * (P+2) * X2; C2:= (Q*C1 + R*C0)/P; D2:= (Q*D1 + R*D0)/P; R1:=R2; R2:=C2/D2; C0:=C1; C1:=C2; D0:=D1; D1:=D2; if ABS(C1) > SCF or ABS(D1) > SCF then begin C0:= C0/SCF; C1:= C1/SCF; D0:= D0/SCF; D1:= D1/SCF end end; KLGAM:= R2/A; GRGAM:= GAM - KLGAM end else begin C0:=A*S; C1:=(1+X)* C0; Q:= X +2 - A; D0:= X; D1:= X * Q; R2:= C1/D1; for N:=1, N+1 while ABS((R2-R1)/R2)>EPS do begin Q:= 2 + Q; R:= N * (N+1-A); C2:= Q*C1-R*C0; D2:= Q*D1-R*D0; R1:=R2; R2:=C2/D2; C0:=C1; C1:=C2; D0:=D1; D1:=D2; if ABS(C1) > SCF or ABS(D1) > SCF then begin C0:= C0/SCF; C1:= C1/SCF; D0:= D0/SCF; D1:= D1/SCF end end; GRGAM:= R2/A; KLGAM:= GAM - GRGAM end end INCOMGAM eop