code 35181;
  procedure BESS YA01(A,X,YA,YA1);value A,X; real A,X,YA,YA1;
  if A = 0 then 
  begin 
    BESS Y01(X,YA,YA1)
  end else 
  begin real B,C,D,E,F,G,H,P,PI,Q,R,S;integer N,NA;
    boolean REC,REV;
    PI:=4*ARCTAN(1);NA:=ENTIER(A+.5);REC:=A>=.5;
    REV:=A<-.5;if REV or REC then A:=A-NA;
    if A=-.5 then 
    begin P:=SQRT(2/PI/X);F:=P*SIN(X);G:=-P*COS(X) end else 
    if X<3 then 
    begin 
      B:=X/2;D:=-LN(B);E:=A*D;
      C:=if ABS(A)<"-8  then 1/PI else A/SIN(A*PI);
      S:=if ABS(E)<"-8  then 1 else SINH(E)/E;
      E:=EXP(E);G:=RECIP GAMMA(A,P,Q)*E;E:=(E+1/E)/2;
      F:=2*C*(P*E+Q*S*D);E:=A*A;
      P:=G*C;Q:=1/G/PI;C:=A*PI/2;
      R:=if ABS(C)<"-8  then 1 else SIN(C)/C;R:=PI*C*R*R;
      C:=1;D:=-B*B;YA:=F+R*Q;YA1:=P;
      for N:=1,N+1 while 
      ABS(G/(1+ABS(YA)))+ABS(H/(1+ABS(YA1)))>"-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*(F+R*Q);H:=C*P-N*G;
        YA:=YA+G;YA1:=YA1+H;
      end;
      F:=-YA;G:=-YA1/B
    end 

    else 
    begin 
      B:=X-PI*(A+.5)/2;C:=COS(B);S:=SIN(B);
      D:=SQRT(2/X/PI);
      BESS PQA01(A,X,P,Q,B,H);
      F:=D*(P*S+Q*C);G:=D*(H*S-B*C)
    end;
    if REV then 
    begin X:=2/X;NA:=-NA-1;
      for N:=0 step 1 until NA do 
      begin H:=X*(A-N)*F-G;G:=F;F:=H end 
    end else if REC then 
    begin X:=2/X;
      for N:=1 step 1 until NA do 
      begin H:=X*(A+N)*G-F;F:=G;G:=H end 
    end;
    YA:=F;YA1:=G
  end BESS YA01;
        eop