code 35191;
  procedure  BESS KA01(A, X, KA, KA1); value A, X;
  real A, X, KA, KA1;
  if A = 0 then 
  begin 
    BESS K01(X,KA,KA1)
  end else 
  begin real F, G, H, PI; integer N, NA; boolean REC, REV;
    PI:= 4 * ARCTAN(1);
    REV:= A < -.5; if REV then A:= -A-1;
    REC:= A >=  .5; if REC then 
    begin NA:=ENTIER(A+.5); A:= A - NA end;
    if A = .5 then F:= G:= SQRT(PI / X / 2) * EXP (-X) else 
    if X < 1 then 
    real A1, B, C, D, E, P, Q, S;
      B:=X/2;D:=-LN(B);E:=A*D;C:=A*PI;
      C:=if ABS(C)<"-15 then 1 else C/SIN(C);
      S:=if ABS(E)<"-15 then 1 else SINH(E)/E;
      E:=EXP(E);A1:=(E+1/E)/2;G:=RECIP GAMMA(A,P,Q)*E;
      KA:=F:=C*(P*A1+Q*S*D);E:=A*A;
      P:=.5*G*C;Q:=.5/G;C:=1;D:=B*B;KA1:=P;
      for N:=1,N+1 while H/KA+ABS(G)/KA1>"-15 do 
      begin F:=(F*N+P+Q)/(N*N-E);C:=C*D/N;
        P:=P/(N-A);Q:=Q/(N+A);G:=C*(P-N*F);
        H:=C*F;KA:=KA+H;KA1:=KA1+G
      end;
      F:=KA;G:=KA1/B
    end else 
    begin real EXPON;
      EXPON:= EXP(-X); NONEXP BESS KA01(A, X, KA, KA1);
      F:= EXPON * KA; G:= EXPON * KA1
    end;
    if REC then 
    begin X:= 2 / X;
      for N:= 1 step 1 until NA do 
      begin H:= F + (A + N) * X * G; F:= G; G:= H end 
    end;
    if REV then begin KA1:= F; KA:= G end else 
    begin KA:= F; KA1:= G end 
  end BESS KA01;
        eop