C FOBEY1    SOURCE    CHAT      05/01/13    00:05:40     5004
      SUBROUTINE  FOBEY1(XR1,NXR1,XR2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C    Include contenant quelques constantes dont XPI :
-INC CCREEL
C
C
C
C  XR1( NXR1) : TABLEAU DE REELS TOUS > 0
C  XR2( NXR1) : TABLEAU DE REELS
C
C           XR2(I) = Y1 (  XR1(I) )
C      Y1 FONCTION DE BESSEL DE DEUXIEME ESPECE D'ORDRE 1
C
C       APPROXIMATION POLYNOMIALE PAR SECTEUR
C       REFERENCE : ABRAMOWITZ HANDBOOK OF MATHEMATICAL FONCTIONS
C      PRECISION E = 1.D-8
C
      DIMENSION XR1(NXR1)
      DIMENSION XR2(NXR1)
      DIMENSION XB(1)
      DIMENSION XBB(1)
C
      A0= -.6366198D0
      A2=  .2212091D0
      A4= 2.1682709D0
      A6=-1.3164827D0
      A8=  .3123951D0
      A10=-.0400976D0
      A12= .0027873D0
C
      B0=  .79788456D0
      B1=  .00000156D0
      B2=  .01659667D0
      B3=  .00017105D0
      B4= -.00249511D0
      B5=  .00113653D0
      B6= -.00020033D0
C
      C0=-2.35619816D0
      C1=  .12499612D0
      C2=  .00005650D0
      C3= -.00637879D0
      C4=  .00074348D0
      C5=  .00079824D0
      C6= -.00029166D0
C
      DO 100  I=1,NXR1
         IF (XR1(I) .LE. 3.D0) THEN
            XB(1)= XR1(I)
            Y2= (XB(1) / 3D0)**2
            CALL FOBEJ1(XB,1,XBB)
            A00=(2.D0 /XPI)*XB(1)*(LOG(XB(1)/2.D0))* XBB(1)
            BB= A00+A0+Y2*(A2+Y2*(A4+Y2*(A6+Y2*(A8+Y2*(A10+Y2*A12)))))
            XR2(I)= BB / XR1(I)
         ELSE
            Y= 3D0/XR1(I)
            F1= B0+Y*(B1+Y*(B2+Y*(B3+Y*(B4+Y*(B5+Y*B6)))))
            T1 = XR1(I)+C0+Y*(C1+Y*(C2+Y*(C3+Y*(C4+Y*(C5+Y*C6)))))
            XR2(I) = (1.D0 / ( XR1(I) ** .5D0)) * F1 * SIN(T1)
         ENDIF
 100  CONTINUE
C
      RETURN
      END