*
* $Id: besy0.F,v 1.1.1.1 1996/02/15 17:49:08 mclareni Exp $
*
* $Log: besy0.F,v $
* Revision 1.1.1.1  1996/02/15 17:49:08  mclareni
* Kernlib
*
*
#include "kernnum/pilot.h"
      REAL FUNCTION BESY0(RX)
      REAL RX,SX
      CHARACTER*6 ENAME
      LOGICAL MFLAG,RFLAG
#if defined(CERNLIB_NUMHIPRE)
      REAL DBESY0,X,Y,H,ALFA,ZERO,ONE,TWO,EIGHT,B0,B1,B2,P,Q,R,D
      REAL PI1,PI2,PI3,CE,C1(0:14),C2(0:14),C3(0:9),C4(0:10)
#endif
#if defined(CERNLIB_NUMLOPRE)
      DOUBLE PRECISION X,Y,H,ALFA,ZERO,ONE,TWO,EIGHT,B0,B1,B2,P,Q,R,D
      DOUBLE PRECISION PI1,PI2,PI3,CE,C1(0:14),C2(0:14),C3(0:9),C4(0:10)
      DOUBLE PRECISION DBESY0,DX
#endif
 
      DATA ZERO /0.0D0/, ONE /1.0D0/, TWO /2.0D0/, EIGHT /8.0D0/
 
      DATA PI1 /0.79788 45608 0287D0/, PI2 /0.63661 97723 6758D0/
      DATA PI3 /0.78539 81633 9745D0/, CE /0.57721 56649 0153D0/
 
      DATA C1( 0) /+0.15772 79714 7489D0/
      DATA C1( 1) /-0.00872 34423 5285D0/
      DATA C1( 2) /+0.26517 86132 0334D0/
      DATA C1( 3) /-0.37009 49938 7265D0/
      DATA C1( 4) /+0.15806 71023 3210D0/
      DATA C1( 5) /-0.03489 37694 1141D0/
      DATA C1( 6) /+0.00481 91800 6947D0/
      DATA C1( 7) /-0.00046 06261 6621D0/
      DATA C1( 8) /+0.00003 24603 2882D0/
      DATA C1( 9) /-0.00000 17619 4691D0/
      DATA C1(10) /+0.00000 00760 8164D0/
      DATA C1(11) /-0.00000 00026 7925D0/
      DATA C1(12) /+0.00000 00000 7849D0/
      DATA C1(13) /-0.00000 00000 0194D0/
      DATA C1(14) /+0.00000 00000 0004D0/
 
      DATA C2( 0) /-0.02150 51114 4966D0/
      DATA C2( 1) /-0.27511 81330 4352D0/
      DATA C2( 2) /+0.19860 56347 0255D0/
      DATA C2( 3) /+0.23425 27461 0902D0/
      DATA C2( 4) /-0.16563 59817 1365D0/
      DATA C2( 5) /+0.04462 13795 4067D0/
      DATA C2( 6) /-0.00693 22862 9152D0/
      DATA C2( 7) /+0.00071 91174 0375D0/
      DATA C2( 8) /-0.00005 39250 7972D0/
      DATA C2( 9) /+0.00000 30764 9329D0/
      DATA C2(10) /-0.00000 01384 5718D0/
      DATA C2(11) /+0.00000 00050 5105D0/
      DATA C2(12) /-0.00000 00001 5258D0/
      DATA C2(13) /+0.00000 00000 0388D0/
      DATA C2(14) /-0.00000 00000 0008D0/
 
      DATA C3( 0) /+0.99946 03493 4752D0/
      DATA C3( 1) /-0.00053 65220 4681D0/
      DATA C3( 2) /+0.00000 30751 8479D0/
      DATA C3( 3) /-0.00000 00517 0595D0/
      DATA C3( 4) /+0.00000 00016 3065D0/
      DATA C3( 5) /-0.00000 00000 7864D0/
      DATA C3( 6) /+0.00000 00000 0517D0/
      DATA C3( 7) /-0.00000 00000 0043D0/
      DATA C3( 8) /+0.00000 00000 0004D0/
      DATA C3( 9) /-0.00000 00000 0001D0/
 
      DATA C4( 0) /-0.01555 58546 05337D0/
      DATA C4( 1) /+0.00006 83851 99426D0/
      DATA C4( 2) /-0.00000 07414 49841D0/
      DATA C4( 3) /+0.00000 00179 72457D0/
      DATA C4( 4) /-0.00000 00007 27192D0/
      DATA C4( 5) /+0.00000 00000 42201D0/
      DATA C4( 6) /-0.00000 00000 03207D0/
      DATA C4( 7) /+0.00000 00000 00301D0/
      DATA C4( 8) /-0.00000 00000 00033D0/
      DATA C4( 9) /+0.00000 00000 00004D0/
      DATA C4(10) /-0.00000 00000 00001D0/
#if defined(CERNLIB_NUMHIPRE)
      ROUND(D)  =  D
#endif
#if defined(CERNLIB_NUMLOPRE)
      ROUND(D)  =  SNGL(D+(D-DBLE(SNGL(D))))
#endif
 
      ENAME=' BESY0'
      X=RX
#if defined(CERNLIB_NUMLOPRE)
      GOTO 9
      ENTRY DBESY0(DX)
      ENAME='DBESY0'
      X=DX
#endif
 
    9 IF(X .LE. ZERO) THEN
       CALL KERMTR('C312.1',LGFILE,MFLAG,RFLAG)
       IF(MFLAG) THEN
        SX=X
        IF(LGFILE .EQ. 0) THEN
         WRITE(*,100) ENAME,SX
        ELSE
         WRITE(LGFILE,100) ENAME,SX
        ENDIF
       ENDIF
       IF(.NOT.RFLAG) CALL ABEND
       IF(ENAME .EQ. ' BESY0')  THEN
          BESY0=ZERO
       ELSE
          DBESY0=ZERO
       ENDIF
       RETURN
      ENDIF
      IF(X .LT. EIGHT) THEN
       Y=X/EIGHT
       H=TWO*Y**2-ONE
       ALFA=-TWO*H
       B1=ZERO
       B2=ZERO
       DO 1 I = 14,0,-1
       B0=C1(I)-ALFA*B1-B2
       B2=B1
    1  B1=B0
       P=B0-H*B2
       B1=ZERO
       B2=ZERO
       DO 2 I = 14,0,-1
       B0=C2(I)-ALFA*B1-B2
       B2=B1
    2  B1=B0
       B1=PI2*(CE+LOG(X/TWO))*P+B0-H*B2
      ELSE
       R=ONE/X
       Y=EIGHT*R
       H=TWO*Y**2-ONE
       ALFA=-TWO*H
       B1=ZERO
       B2=ZERO
       DO 3 I = 9,0,-1
       B0=C3(I)-ALFA*B1-B2
       B2=B1
    3  B1=B0
       P=B0-H*B2
       B1=ZERO
       B2=ZERO
       DO 4 I = 10,0,-1
       B0=C4(I)-ALFA*B1-B2
       B2=B1
    4  B1=B0
       Q=Y*(B0-H*B2)
       B0=X-PI3
       B1=PI1*SQRT(R)*(Q*COS(B0)+P*SIN(B0))
      ENDIF
      IF(ENAME .EQ. ' BESY0')  THEN
         BESY0=ROUND(B1)
      ELSE
         DBESY0=B1
      ENDIF
      RETURN
  100 FORMAT(7X,A6,' ... NON-POSITIVE ARGUMENT X = ',E16.6)
      END